------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Opts
-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Fri Nov 30, 2018 01:19
--
--
-- Command line option parsing
--
------------------------------------------------------------------------------

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