------------------------------------------------------------------------------
-- |
-- 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 Xmobar.X11.Loop (x11Loop)
import Xmobar.Text.Loop (textLoop)
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
import Xmobar.App.Compile (recompile, trace)

xmobar :: Config -> IO ()
xmobar :: Config -> IO ()
xmobar Config
cfg = if Config -> Bool
textOutput Config
cfg then Config -> IO ()
textLoop Config
cfg else Config -> IO ()
x11Loop Config
cfg

configFromArgs :: Config -> IO Config
configFromArgs :: Config -> IO Config
configFromArgs Config
cfg = IO [String]
getArgs IO [String]
-> ([String] -> IO ([Opts], [String])) -> IO ([Opts], [String])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO ([Opts], [String])
getOpts IO ([Opts], [String])
-> (([Opts], [String]) -> IO Config) -> IO Config
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> [Opts] -> IO Config
doOpts Config
cfg ([Opts] -> IO Config)
-> (([Opts], [String]) -> [Opts])
-> ([Opts], [String])
-> IO Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Opts], [String]) -> [Opts]
forall a b. (a, b) -> a
fst

buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch [String]
args Bool
verb Bool
force String
p ParseError
e = do
  let exec :: String
exec = String -> String
takeBaseName String
p
      confDir :: String
confDir = String -> String
takeDirectory String
p
      ext :: String
ext = String -> String
takeExtension String
p
  if String
ext String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
".hs", String
".hsc", String
".lhs"]
    then IO String
xmobarDataDir IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
dd -> String -> String -> String -> Bool -> Bool -> IO Bool
forall (m :: * -> *).
MonadIO m =>
String -> String -> String -> Bool -> Bool -> m Bool
recompile String
confDir String
dd String
exec Bool
force Bool
verb IO Bool -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
         String -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile (String
confDir String -> String -> String
</> String
exec) Bool
False [String]
args Maybe [(String, String)]
forall a. Maybe a
Nothing
    else Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
trace Bool
True (String
"Invalid configuration file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
         Bool -> String -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> String -> m ()
trace Bool
True String
"\n(No compilation attempted: \
                    \only .hs, .hsc or .lhs files are compiled)"

xmobar' :: [String] -> Config -> IO ()
xmobar' :: [String] -> Config -> IO ()
xmobar' [String]
defs Config
cfg = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
defs Bool -> Bool -> Bool
|| Bool -> Bool
not (Config -> Bool
verbose Config
cfg)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Fields missing from config defaulted: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
defs
  Config -> IO ()
xmobar Config
cfg

xmobarMain :: IO ()
xmobarMain :: IO ()
xmobarMain = do
  [String]
args <- IO [String]
getArgs
  ([Opts]
flags, [String]
rest) <- [String] -> IO ([Opts], [String])
getOpts [String]
args
  Maybe String
cf <- case [String]
rest of
          [String
c] -> Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
c)
          [] -> IO (Maybe String)
xmobarConfigFile
          [String]
_ -> String -> IO (Maybe String)
forall a. HasCallStack => String -> a
error (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"Too many arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
rest
  case Maybe String
cf of
    Maybe String
Nothing -> case [String]
rest of
                (String
c:[String]
_) -> String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": file not found"
                [String]
_ -> Config -> [Opts] -> IO Config
doOpts Config
defaultConfig [Opts]
flags IO Config -> (Config -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> IO ()
xmobar
    Just String
p -> do Either ParseError (Config, [String])
r <- Config -> String -> IO (Either ParseError (Config, [String]))
readConfig Config
defaultConfig String
p
                 case Either ParseError (Config, [String])
r of
                   Left ParseError
e ->
                     [String] -> Bool -> Bool -> String -> ParseError -> IO ()
buildLaunch ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
p) [String]
args) ([Opts] -> Bool
verboseFlag [Opts]
flags)
                                 ([Opts] -> Bool
recompileFlag [Opts]
flags) String
p ParseError
e
                   Right (Config
c, [String]
defs) -> Config -> [Opts] -> IO Config
doOpts Config
c [Opts]
flags IO Config -> (Config -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> Config -> IO ()
xmobar' [String]
defs