module Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) where
import Control.Monad (when)
import System.Console.GetOpt
import System.Exit (exitSuccess, exitWith, ExitCode(..))
import Data.Version (showVersion)
import Text.Read (readMaybe)
import Paths_xmobar (version)
import Xmobar.Config.Types
data Opts = Help
| Verbose
| Recompile
| Version
| Font String
| BgColor String
| FgColor String
| Alpha String
| T
| B
| D
| AlignSep String
| Commands String
| AddCommand String
| SepChar String
| Template String
| OnScr String
| IconRoot String
| Position String
| WmClass String
| WmName String
deriving (Int -> Opts -> ShowS
[Opts] -> ShowS
Opts -> String
(Int -> Opts -> ShowS)
-> (Opts -> String) -> ([Opts] -> ShowS) -> Show Opts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Opts] -> ShowS
$cshowList :: [Opts] -> ShowS
show :: Opts -> String
$cshow :: Opts -> String
showsPrec :: Int -> Opts -> ShowS
$cshowsPrec :: Int -> Opts -> ShowS
Show, Opts -> Opts -> Bool
(Opts -> Opts -> Bool) -> (Opts -> Opts -> Bool) -> Eq Opts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Opts -> Opts -> Bool
$c/= :: Opts -> Opts -> Bool
== :: Opts -> Opts -> Bool
$c== :: Opts -> Opts -> Bool
Eq)
options :: [OptDescr Opts]
options :: [OptDescr Opts]
options =
[ String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "h?" ["help"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Help) "This help"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "v" ["verbose"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Verbose) "Emit verbose debugging messages"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "r" ["recompile"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Recompile) "Force recompilation"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "V" ["version"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Version) "Show version information"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "f" ["font"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Font "font name") "Font name"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "w" ["wmclass"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmClass "class") "X11 WM_CLASS property"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "n" ["wmname"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmName "name") "X11 WM_NAME property"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "B" ["bgcolor"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
BgColor "bg color" )
"The background color. Default black"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "F" ["fgcolor"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
FgColor "fg color")
"The foreground color. Default grey"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "i" ["iconroot"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
IconRoot "path")
"Root directory for icon pattern paths. Default '.'"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "A" ["alpha"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Alpha "alpha")
"Transparency: 0 is transparent, 255 is opaque. Default: 255"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "o" ["top"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
T) "Place xmobar at the top of the screen"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "b" ["bottom"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
B)
"Place xmobar at the bottom of the screen"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "d" ["dock"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
D)
"Don't override redirect from WM and function as a dock"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "a" ["alignsep"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AlignSep "alignsep")
"Separators for left, center and right text\nalignment. Default: '}{'"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "s" ["sepchar"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
SepChar "char")
("Character used to separate commands in" String -> ShowS
forall a. [a] -> [a] -> [a]
++
"\nthe output template. Default '%'")
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "t" ["template"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Template "template")
"Output template"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "c" ["commands"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Commands "commands")
"List of commands to be executed"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "C" ["add-command"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AddCommand "command")
"Add to the list of commands to be executed"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "x" ["screen"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
OnScr "screen")
"On which X screen number to start"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option "p" ["position"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Position "position")
"Specify position of xmobar. Same syntax as in config file"
]
getOpts :: [String] -> IO ([Opts], [String])
getOpts :: [String] -> IO ([Opts], [String])
getOpts argv :: [String]
argv = do
(o :: [Opts]
o,n :: [String]
n) <- case ArgOrder Opts
-> [OptDescr Opts] -> [String] -> ([Opts], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder Opts
forall a. ArgOrder a
Permute [OptDescr Opts]
options [String]
argv of
(o :: [Opts]
o,n :: [String]
n,[]) -> ([Opts], [String]) -> IO ([Opts], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opts]
o,[String]
n)
(_,_,errs :: [String]
errs) -> String -> IO ([Opts], [String])
forall a. HasCallStack => String -> a
error ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usage)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts
Help Opts -> [Opts] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opts]
o) (String -> IO ()
putStr String
usage IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts
Version Opts -> [Opts] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opts]
o) (String -> IO ()
putStr String
info IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
([Opts], [String]) -> IO ([Opts], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opts]
o, [String]
n)
usage :: String
usage :: String
usage = String -> [OptDescr Opts] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr Opts]
options String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
footer
where header :: String
header = "Usage: xmobar [OPTION...] [FILE]\nOptions:"
footer :: String
footer = "\nMail bug reports and suggestions to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mail String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
info :: String
info :: String
info = "xmobar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n (C) 2010 - 2020 Jose A Ortega Ruiz"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n (C) 2007 - 2010 Andrea Rossato\n "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mail String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
license String -> ShowS
forall a. [a] -> [a] -> [a]
++ "\n"
mail :: String
mail :: String
mail = "<mail@jao.io>"
license :: String
license :: String
license = "\nThis program is distributed in the hope that it will be useful," String -> ShowS
forall a. [a] -> [a] -> [a]
++
"\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" String -> ShowS
forall a. [a] -> [a] -> [a]
++
"\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." String -> ShowS
forall a. [a] -> [a] -> [a]
++
"\nSee the License for more details."
doOpts :: Config -> [Opts] -> IO Config
doOpts :: Config -> [Opts] -> IO Config
doOpts conf :: Config
conf [] =
Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
conf {lowerOnStart :: Bool
lowerOnStart = Config -> Bool
lowerOnStart Config
conf Bool -> Bool -> Bool
&& Config -> Bool
overrideRedirect Config
conf})
doOpts conf :: Config
conf (o :: Opts
o:oo :: [Opts]
oo) =
case Opts
o of
Help -> Config -> IO Config
doOpts' Config
conf
Version -> Config -> IO Config
doOpts' Config
conf
Recompile -> Config -> IO Config
doOpts' Config
conf
Verbose -> Config -> IO Config
doOpts' (Config
conf {verbose :: Bool
verbose = Bool
True})
Font s :: String
s -> Config -> IO Config
doOpts' (Config
conf {font :: String
font = String
s})
WmClass s :: String
s -> Config -> IO Config
doOpts' (Config
conf {wmClass :: String
wmClass = String
s})
WmName s :: String
s -> Config -> IO Config
doOpts' (Config
conf {wmName :: String
wmName = String
s})
BgColor s :: String
s -> Config -> IO Config
doOpts' (Config
conf {bgColor :: String
bgColor = String
s})
FgColor s :: String
s -> Config -> IO Config
doOpts' (Config
conf {fgColor :: String
fgColor = String
s})
Alpha n :: String
n -> Config -> IO Config
doOpts' (Config
conf {alpha :: Int
alpha = String -> Int
forall a. Read a => String -> a
read String
n})
T -> Config -> IO Config
doOpts' (Config
conf {position :: XPosition
position = XPosition
Top})
B -> Config -> IO Config
doOpts' (Config
conf {position :: XPosition
position = XPosition
Bottom})
D -> Config -> IO Config
doOpts' (Config
conf {overrideRedirect :: Bool
overrideRedirect = Bool
False})
AlignSep s :: String
s -> Config -> IO Config
doOpts' (Config
conf {alignSep :: String
alignSep = String
s})
SepChar s :: String
s -> Config -> IO Config
doOpts' (Config
conf {sepChar :: String
sepChar = String
s})
Template s :: String
s -> Config -> IO Config
doOpts' (Config
conf {template :: String
template = String
s})
IconRoot s :: String
s -> Config -> IO Config
doOpts' (Config
conf {iconRoot :: String
iconRoot = String
s})
OnScr n :: String
n -> Config -> IO Config
doOpts' (Config
conf {position :: XPosition
position = Int -> XPosition -> XPosition
OnScreen (String -> Int
forall a. Read a => String -> a
read String
n) (XPosition -> XPosition) -> XPosition -> XPosition
forall a b. (a -> b) -> a -> b
$ Config -> XPosition
position Config
conf})
Commands s :: String
s -> case Char -> String -> Either String [Runnable]
forall b. Read b => Char -> String -> Either String b
readCom 'c' String
s of
Right x :: [Runnable]
x -> Config -> IO Config
doOpts' (Config
conf {commands :: [Runnable]
commands = [Runnable]
x})
Left e :: String
e -> String -> IO ()
putStr (String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usage) IO () -> IO Config -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExitCode -> IO Config
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
AddCommand s :: String
s -> case Char -> String -> Either String [Runnable]
forall b. Read b => Char -> String -> Either String b
readCom 'C' String
s of
Right x :: [Runnable]
x -> Config -> IO Config
doOpts' (Config
conf {commands :: [Runnable]
commands = Config -> [Runnable]
commands Config
conf [Runnable] -> [Runnable] -> [Runnable]
forall a. [a] -> [a] -> [a]
++ [Runnable]
x})
Left e :: String
e -> String -> IO ()
putStr (String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
usage) IO () -> IO Config -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExitCode -> IO Config
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure 1)
Position s :: String
s -> String -> IO Config
readPosition String
s
where readCom :: Char -> String -> Either String b
readCom c :: Char
c str :: String
str =
case String -> [b]
forall a. Read a => String -> [a]
readStr String
str of
[x :: b
x] -> b -> Either String b
forall a b. b -> Either a b
Right b
x
_ -> String -> Either String b
forall a b. a -> Either a b
Left ("xmobar: cannot read list of commands " String -> ShowS
forall a. [a] -> [a] -> [a]
++
"specified with the -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:" option\n")
readStr :: String -> [a]
readStr str :: String
str = [a
x | (x :: a
x,t :: String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
str, ("","") <- ReadS String
lex String
t]
doOpts' :: Config -> IO Config
doOpts' c :: Config
c = Config -> [Opts] -> IO Config
doOpts Config
c [Opts]
oo
readPosition :: String -> IO Config
readPosition string :: String
string =
case String -> Maybe XPosition
forall a. Read a => String -> Maybe a
readMaybe String
string of
Just x :: XPosition
x -> Config -> IO Config
doOpts' (Config
conf { position :: XPosition
position = XPosition
x })
Nothing -> do
String -> IO ()
putStrLn "Can't parse position option, ignoring"
Config -> IO Config
doOpts' Config
conf
recompileFlag :: [Opts] -> Bool
recompileFlag :: [Opts] -> Bool
recompileFlag = Opts -> [Opts] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opts
Recompile
verboseFlag :: [Opts] -> Bool
verboseFlag :: [Opts] -> Bool
verboseFlag = Opts -> [Opts] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opts
Verbose