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
| TextOutput (Maybe String)
| Font String
| AddFont 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 String
"h?" [String
"help"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Help) String
"This help"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Verbose) String
"Emit verbose debugging messages"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"r" [String
"recompile"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Recompile) String
"Force recompilation"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"V" [String
"version"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Version) String
"Show version information"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"T" [String
"text"] ((Maybe String -> Opts) -> String -> ArgDescr Opts
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg Maybe String -> Opts
TextOutput String
"color")
String
"Write text-only output to stdout. Plain/Ansi/Pango/Swaybar"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"f" [String
"font"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Font String
"font name") String
"Font name"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"N" [String
"add-font"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AddFont String
"font name")
String
"Add to the list of additional fonts"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"w" [String
"wmclass"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmClass String
"class") String
"X11 WM_CLASS property"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"n" [String
"wmname"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmName String
"name") String
"X11 WM_NAME property"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"B" [String
"bgcolor"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
BgColor String
"bg color" )
String
"The background color. Default black"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"F" [String
"fgcolor"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
FgColor String
"fg color")
String
"The foreground color. Default grey"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" [String
"iconroot"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
IconRoot String
"path")
String
"Root directory for icon pattern paths. Default '.'"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"A" [String
"alpha"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Alpha String
"alpha")
String
"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 String
"o" [String
"top"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
T) String
"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 String
"b" [String
"bottom"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
B)
String
"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 String
"d" [String
"dock"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
D)
String
"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 String
"a" [String
"alignsep"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AlignSep String
"alignsep")
String
"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 String
"s" [String
"sepchar"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
SepChar String
"char")
(String
"Character used to separate commands in" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\nthe output template. Default '%'")
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"t" [String
"template"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Template String
"template")
String
"Output template"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"commands"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Commands String
"commands")
String
"List of commands to be executed"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"C" [String
"add-command"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AddCommand String
"command")
String
"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 String
"x" [String
"screen"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
OnScr String
"screen")
String
"On which X screen number to start"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"position"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Position String
"position")
String
"Specify position of xmobar. Same syntax as in config file"
]
getOpts :: [String] -> IO ([Opts], [String])
getOpts :: [String] -> IO ([Opts], [String])
getOpts [String]
argv = do
([Opts]
o,[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
([Opts]
o,[String]
n,[]) -> ([Opts], [String]) -> IO ([Opts], [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opts]
o,[String]
n)
([Opts]
_,[String]
_,[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 = String
"Usage: xmobar [OPTION...] [FILE]\nOptions:"
footer :: String
footer = String
"\nMail bug reports and suggestions to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mail String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
info :: String
info :: String
info = String
"xmobar " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n (C) 2010 - 2022 Jose A Ortega Ruiz"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n (C) 2007 - 2010 Andrea Rossato\n "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
mail String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
license String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
mail :: String
mail :: String
mail = String
"<mail@jao.io>"
license :: String
license :: String
license = String
"\nThis program is distributed in the hope that it will be useful," String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"\nSee the License for more details."
doOpts :: Config -> [Opts] -> IO Config
doOpts :: Config -> [Opts] -> IO Config
doOpts 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 Config
conf (Opts
o:[Opts]
oo) =
case Opts
o of
Opts
Help -> Config -> IO Config
doOpts' Config
conf
Opts
Version -> Config -> IO Config
doOpts' Config
conf
Opts
Recompile -> Config -> IO Config
doOpts' Config
conf
TextOutput Maybe String
s -> Config -> IO Config
doOpts' (Config -> IO Config) -> Config -> IO Config
forall a b. (a -> b) -> a -> b
$ case Maybe String
s of
Just String
fmt -> Config
conf {textOutput :: Bool
textOutput = Bool
True,
textOutputFormat :: TextOutputFormat
textOutputFormat = String -> TextOutputFormat
forall a. Read a => String -> a
read String
fmt}
Maybe String
Nothing -> Config
conf {textOutput :: Bool
textOutput = Bool
True}
Opts
Verbose -> Config -> IO Config
doOpts' (Config
conf {verbose :: Bool
verbose = Bool
True})
Font String
s -> Config -> IO Config
doOpts' (Config
conf {font :: String
font = String
s})
AddFont String
s -> Config -> IO Config
doOpts' (Config
conf {additionalFonts :: [String]
additionalFonts = Config -> [String]
additionalFonts Config
conf [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
s]})
WmClass String
s -> Config -> IO Config
doOpts' (Config
conf {wmClass :: String
wmClass = String
s})
WmName String
s -> Config -> IO Config
doOpts' (Config
conf {wmName :: String
wmName = String
s})
BgColor String
s -> Config -> IO Config
doOpts' (Config
conf {bgColor :: String
bgColor = String
s})
FgColor String
s -> Config -> IO Config
doOpts' (Config
conf {fgColor :: String
fgColor = String
s})
Alpha String
n -> Config -> IO Config
doOpts' (Config
conf {alpha :: Int
alpha = String -> Int
forall a. Read a => String -> a
read String
n})
Opts
T -> Config -> IO Config
doOpts' (Config
conf {position :: XPosition
position = XPosition
Top})
Opts
B -> Config -> IO Config
doOpts' (Config
conf {position :: XPosition
position = XPosition
Bottom})
Opts
D -> Config -> IO Config
doOpts' (Config
conf {overrideRedirect :: Bool
overrideRedirect = Bool
False})
AlignSep String
s -> Config -> IO Config
doOpts' (Config
conf {alignSep :: String
alignSep = String
s})
SepChar String
s -> Config -> IO Config
doOpts' (Config
conf {sepChar :: String
sepChar = String
s})
Template String
s -> Config -> IO Config
doOpts' (Config
conf {template :: String
template = String
s})
IconRoot String
s -> Config -> IO Config
doOpts' (Config
conf {iconRoot :: String
iconRoot = String
s})
OnScr 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 String
s -> case Char -> String -> Either String [Runnable]
forall b. Read b => Char -> String -> Either String b
readCom Char
'c' String
s of
Right [Runnable]
x -> Config -> IO Config
doOpts' (Config
conf {commands :: [Runnable]
commands = [Runnable]
x})
Left 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 Int
1)
AddCommand String
s -> case Char -> String -> Either String [Runnable]
forall b. Read b => Char -> String -> Either String b
readCom Char
'C' String
s of
Right [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 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 Int
1)
Position String
s -> String -> IO Config
readPosition String
s
where readCom :: Char -> String -> Either String b
readCom Char
c String
str =
case String -> [b]
forall a. Read a => String -> [a]
readStr String
str of
[b
x] -> b -> Either String b
forall a b. b -> Either a b
Right b
x
[b]
_ -> String -> Either String b
forall a b. a -> Either a b
Left (String
"xmobar: cannot read list of commands " String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"specified with the -" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
" option\n")
readStr :: String -> [a]
readStr String
str = [a
x | (a
x,String
t) <- ReadS a
forall a. Read a => ReadS a
reads String
str, (String
"",String
"") <- ReadS String
lex String
t]
doOpts' :: Config -> IO Config
doOpts' Config
c = Config -> [Opts] -> IO Config
doOpts Config
c [Opts]
oo
readPosition :: String -> IO Config
readPosition String
string =
case String -> Maybe XPosition
forall a. Read a => String -> Maybe a
readMaybe String
string of
Just XPosition
x -> Config -> IO Config
doOpts' (Config
conf { position :: XPosition
position = XPosition
x })
Maybe XPosition
Nothing -> do
String -> IO ()
putStrLn String
"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