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
| Dpi String
deriving (Int -> Opts -> ShowS
[Opts] -> ShowS
Opts -> String
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
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 =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"h?" [String
"help"] (forall a. a -> ArgDescr a
NoArg Opts
Help) String
"This help"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"v" [String
"verbose"] (forall a. a -> ArgDescr a
NoArg Opts
Verbose) String
"Emit verbose debugging messages"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"r" [String
"recompile"] (forall a. a -> ArgDescr a
NoArg Opts
Recompile) String
"Force recompilation"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"V" [String
"version"] (forall a. a -> ArgDescr a
NoArg Opts
Version) String
"Show version information"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"T" [String
"text"] (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"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"f" [String
"font"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Font String
"font name") String
"Font name"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"N" [String
"add-font"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AddFont String
"font name")
String
"Add to the list of additional fonts"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"w" [String
"wmclass"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmClass String
"class") String
"X11 WM_CLASS property"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"n" [String
"wmname"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
WmName String
"name") String
"X11 WM_NAME property"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"B" [String
"bgcolor"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
BgColor String
"bg color" )
String
"The background color. Default black"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"F" [String
"fgcolor"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
FgColor String
"fg color")
String
"The foreground color. Default grey"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"i" [String
"iconroot"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
IconRoot String
"path")
String
"Root directory for icon pattern paths. Default '.'"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"A" [String
"alpha"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Alpha String
"alpha")
String
"Transparency: 0 is transparent, 255 is opaque. Default: 255"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"o" [String
"top"] (forall a. a -> ArgDescr a
NoArg Opts
T) String
"Place xmobar at the top of the screen"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"b" [String
"bottom"] (forall a. a -> ArgDescr a
NoArg Opts
B)
String
"Place xmobar at the bottom of the screen"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"d" [String
"dock"] (forall a. a -> ArgDescr a
NoArg Opts
D)
String
"Don't override redirect from WM and function as a dock"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"a" [String
"alignsep"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AlignSep String
"alignsep")
String
"Separators for left, center and right text\nalignment. Default: '}{'"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"s" [String
"sepchar"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
SepChar String
"char")
(String
"Character used to separate commands in" forall a. [a] -> [a] -> [a]
++
String
"\nthe output template. Default '%'")
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"t" [String
"template"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Template String
"template")
String
"Output template"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"commands"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Commands String
"commands")
String
"List of commands to be executed"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"C" [String
"add-command"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
AddCommand String
"command")
String
"Add to the list of commands to be executed"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"x" [String
"screen"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
OnScr String
"screen")
String
"On which X screen number to start"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"position"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Position String
"position")
String
"Specify position of xmobar. Same syntax as in config file"
, forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"D" [String
"dpi"] (forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Dpi String
"dpi")
String
"The DPI scaling factor. Default 96.0"
]
getOpts :: [String] -> IO ([Opts], [String])
getOpts :: [String] -> IO ([Opts], [String])
getOpts [String]
argv = do
([Opts]
o,[String]
n) <- case forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt forall a. ArgOrder a
Permute [OptDescr Opts]
options [String]
argv of
([Opts]
o,[String]
n,[]) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Opts]
o,[String]
n)
([Opts]
_,[String]
_,[String]
errs) -> forall a. HasCallStack => String -> a
error (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs forall a. [a] -> [a] -> [a]
++ String
usage)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts
Help forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opts]
o) (String -> IO ()
putStr String
usage forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitSuccess)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Opts
Version forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Opts]
o) (String -> IO ()
putStr String
info forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitSuccess)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Opts]
o, [String]
n)
usage :: String
usage :: String
usage = forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr Opts]
options 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 " forall a. [a] -> [a] -> [a]
++ String
mail forall a. [a] -> [a] -> [a]
++ String
"\n"
info :: String
info :: String
info = String
"xmobar " forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version
forall a. [a] -> [a] -> [a]
++ String
"\n (C) 2010 - 2022 Jose A Ortega Ruiz"
forall a. [a] -> [a] -> [a]
++ String
"\n (C) 2007 - 2010 Andrea Rossato\n "
forall a. [a] -> [a] -> [a]
++ String
mail forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ String
license 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," forall a. [a] -> [a] -> [a]
++
String
"\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" forall a. [a] -> [a] -> [a]
++
String
"\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." 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 [] =
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' 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 = 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 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 = 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 (forall a. Read a => String -> a
read String
n) forall a b. (a -> b) -> a -> b
$ Config -> XPosition
position Config
conf})
Commands String
s -> case 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 forall a. [a] -> [a] -> [a]
++ String
usage) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
AddCommand String
s -> case 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 forall a. [a] -> [a] -> [a]
++ [Runnable]
x})
Left String
e -> String -> IO ()
putStr (String
e forall a. [a] -> [a] -> [a]
++ String
usage) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
Position String
s -> String -> IO Config
readPosition String
s
Dpi String
d -> Config -> IO Config
doOpts' (Config
conf {dpi :: Double
dpi = forall a. Read a => String -> a
read String
d})
where readCom :: Char -> String -> Either String b
readCom Char
c String
str =
case forall {a}. Read a => String -> [a]
readStr String
str of
[b
x] -> forall a b. b -> Either a b
Right b
x
[b]
_ -> forall a b. a -> Either a b
Left (String
"xmobar: cannot read list of commands " forall a. [a] -> [a] -> [a]
++
String
"specified with the -" forall a. [a] -> [a] -> [a]
++ Char
cforall a. a -> [a] -> [a]
:String
" option\n")
readStr :: String -> [a]
readStr String
str = [a
x | (a
x,String
t) <- 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 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 = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opts
Recompile
verboseFlag :: [Opts] -> Bool
verboseFlag :: [Opts] -> Bool
verboseFlag = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Opts
Verbose