1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Main
-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Nov 25, 2018 21:53
--
--
-- Support for creating executable main functions
--
------------------------------------------------------------------------------
module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where
import Data.List (intercalate)
import System.Posix.Process (executeFile)
import System.Environment (getArgs)
import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)
import Text.Parsec.Error (ParseError)
import Control.Monad (unless)
import Xmobar.App.Config
import Xmobar.Config.Types
import Xmobar.Config.Parse
import qualified Xmobar.X11.Loop as X11
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
import Xmobar.App.TextEventLoop (textLoop)
import Xmobar.App.Compile (recompile, trace)
xmobar :: Config -> IO ()
xmobar cfg = if textOutput cfg then textLoop cfg else X11.loop cfg
configFromArgs :: Config -> IO Config
configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch args verb force p e = do
let exec = takeBaseName p
confDir = takeDirectory p
ext = takeExtension p
if ext `elem` [".hs", ".hsc", ".lhs"]
then xmobarDataDir >>= \dd -> recompile confDir dd exec force verb >>
executeFile (confDir </> exec) False args Nothing
else trace True ("Invalid configuration file: " ++ show e) >>
trace True "\n(No compilation attempted: \
\only .hs, .hsc or .lhs files are compiled)"
xmobar' :: [String] -> Config -> IO ()
xmobar' defs cfg = do
unless (null defs || not (verbose cfg)) $ putStrLn $
"Fields missing from config defaulted: " ++ intercalate "," defs
xmobar cfg
xmobarMain :: IO ()
xmobarMain = do
args <- getArgs
(flags, rest) <- getOpts args
cf <- case rest of
[c] -> return (Just c)
[] -> xmobarConfigFile
_ -> error $ "Too many arguments: " ++ show rest
case cf of
Nothing -> case rest of
(c:_) -> error $ c ++ ": file not found"
_ -> doOpts defaultConfig flags >>= xmobar
Just p -> do r <- readConfig defaultConfig p
case r of
Left e ->
buildLaunch (filter (/= p) args) (verboseFlag flags)
(recompileFlag flags) p e
Right (c, defs) -> doOpts c flags >>= xmobar' defs
|
