diff options
Diffstat (limited to 'src/app')
| -rw-r--r-- | src/app/Configuration.hs | 59 | ||||
| -rw-r--r-- | src/app/Main.hs | 111 |
2 files changed, 67 insertions, 103 deletions
diff --git a/src/app/Configuration.hs b/src/app/Configuration.hs index db5c109..e1e3c24 100644 --- a/src/app/Configuration.hs +++ b/src/app/Configuration.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, CPP #-} ------------------------------------------------------------------------------ -- | @@ -17,14 +17,33 @@ ------------------------------------------------------------------------------ -module Configuration (parseConfig) where +module Configuration (readConfig, readDefaultConfig) where import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Number (int) import Text.ParserCombinators.Parsec.Perm ((<|?>), (<$?>), permute) +import Control.Monad.IO.Class (liftIO) + +import System.Posix.Files +import System.FilePath ((</>)) +import System.Environment +import System.Directory (getHomeDirectory) + +import Xmobar.Config import qualified Xmobar.Config as C +#if defined XFT || defined UTF8 +import qualified System.IO as S (readFile,hGetLine) +#endif + +readFileSafe :: FilePath -> IO String +#if defined XFT || defined UTF8 +readFileSafe = S.readFile +#else +readFileSafe = readFile +#endif + stripComments :: String -> String stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines @@ -156,3 +175,39 @@ commandsErr = "commands: this usually means that a command could not" ++ "\nbe parsed." ++ "\nThe error could be located at the begining of the command" ++ "\nwhich follows the offending one." + +-- | Reads the configuration files or quits with an error +readConfig :: FilePath -> String -> IO (Config,[String]) +readConfig f usage = do + file <- liftIO $ fileExist f + s <- liftIO $ if file then readFileSafe f else error $ + f ++ ": file not found!\n" ++ usage + either (\err -> error $ f ++ + ": configuration file contains errors at:\n" ++ show err) + return $ parseConfig s + +xdgConfigDir :: IO String +xdgConfigDir = do env <- getEnvironment + case lookup "XDG_CONFIG_HOME" env of + Just val -> return val + Nothing -> fmap (</> ".config") getHomeDirectory + +xmobarConfigDir :: IO FilePath +xmobarConfigDir = fmap (</> "xmobar") xdgConfigDir + +getXdgConfigFile :: IO FilePath +getXdgConfigFile = fmap (</> "xmobarrc") xmobarConfigDir + +-- | Read default configuration file or load the default config +readDefaultConfig :: String -> IO (Config,[String]) +readDefaultConfig usage = do + xdgConfigFile <- getXdgConfigFile + xdgConfigFileExists <- liftIO $ fileExist xdgConfigFile + home <- liftIO $ getEnv "HOME" + let defaultConfigFile = home ++ "/.xmobarrc" + defaultConfigFileExists <- liftIO $ fileExist defaultConfigFile + if xdgConfigFileExists + then readConfig xdgConfigFile usage + else if defaultConfigFileExists + then readConfig defaultConfigFile usage + else return (defaultConfig,[]) diff --git a/src/app/Main.hs b/src/app/Main.hs index 22834b1..0760d16 100644 --- a/src/app/Main.hs +++ b/src/app/Main.hs @@ -13,126 +13,35 @@ -- ----------------------------------------------------------------------------- -module Main ( -- * Main Stuff - -- $main - main - , readConfig - , readDefaultConfig - ) where +module Main (main) where -import Xmobar -import Xmobar.Parsers -import Xmobar.Config -import Xmobar.XUtil - -import Data.Foldable (for_) import Data.List (intercalate) -import qualified Data.Map as Map import Data.Version (showVersion) -import Graphics.X11.Xlib import System.Console.GetOpt -import System.Directory (getHomeDirectory) import System.Exit -import System.Environment -import System.FilePath ((</>)) -import System.Posix.Files -import Control.Concurrent.Async (Async, cancel) -import Control.Exception (bracket) +import System.Environment (getArgs) import Control.Monad (unless) -import Control.Monad.IO.Class (liftIO) import Text.Read (readMaybe) -import Xmobar.Signal (setupSignalHandler, withDeferSignals) +import Xmobar (xmobar) +import Xmobar.Config import Paths_xmobar (version) -import Configuration +import Configuration (readConfig, readDefaultConfig) -- $main -- | The main entry point main :: IO () -main = withDeferSignals $ do - initThreads - d <- openDisplay "" - args <- getArgs - (o,file) <- getOpts args +main = do + (o,file) <- getArgs >>= getOpts (c,defaultings) <- case file of - [cfgfile] -> readConfig cfgfile - _ -> readDefaultConfig - + [cfgfile] -> readConfig cfgfile usage + _ -> readDefaultConfig usage unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: " ++ intercalate "," defaultings - - conf <- doOpts c o - fs <- initFont d (font conf) - fl <- mapM (initFont d) (additionalFonts conf) - cls <- mapM (parseTemplate conf) (splitTemplate conf) - sig <- setupSignalHandler - bracket (mapM (mapM $ startCommand sig) cls) - cleanupThreads - $ \vars -> do - (r,w) <- createWin d fs conf - let ic = Map.empty - to = textOffset conf - ts = textOffsets conf ++ replicate (length fl) (-1) - startLoop (XConf d r w (fs:fl) (to:ts) ic conf) sig vars - -cleanupThreads :: [[([Async ()], a)]] -> IO () -cleanupThreads vars = - -- putStrLn "In cleanupThreads" - for_ (concat vars) $ \(asyncs, _) -> - for_ asyncs cancel - --- | Splits the template in its parts -splitTemplate :: Config -> [String] -splitTemplate conf = - case break (==l) t of - (le,_:re) -> case break (==r) re of - (ce,_:ri) -> [le, ce, ri] - _ -> def - _ -> def - where [l, r] = alignSep - (if length (alignSep conf) == 2 then conf else defaultConfig) - t = template conf - def = [t, "", ""] - - --- | Reads the configuration files or quits with an error -readConfig :: FilePath -> IO (Config,[String]) -readConfig f = do - file <- liftIO $ fileExist f - s <- liftIO $ if file then readFileSafe f else error $ - f ++ ": file not found!\n" ++ usage - either (\err -> error $ f ++ - ": configuration file contains errors at:\n" ++ show err) - return $ parseConfig s - -xdgConfigDir :: IO String -xdgConfigDir = do env <- getEnvironment - case lookup "XDG_CONFIG_HOME" env of - Just val -> return val - Nothing -> fmap (</> ".config") getHomeDirectory - -xmobarConfigDir :: IO FilePath -xmobarConfigDir = fmap (</> "xmobar") xdgConfigDir - -getXdgConfigFile :: IO FilePath -getXdgConfigFile = fmap (</> "xmobarrc") xmobarConfigDir - --- | Read default configuration file or load the default config -readDefaultConfig :: IO (Config,[String]) -readDefaultConfig = do - xdgConfigFile <- getXdgConfigFile - xdgConfigFileExists <- liftIO $ fileExist xdgConfigFile - home <- liftIO $ getEnv "HOME" - let defaultConfigFile = home ++ "/.xmobarrc" - defaultConfigFileExists <- liftIO $ fileExist defaultConfigFile - if xdgConfigFileExists - then readConfig xdgConfigFile - else if defaultConfigFileExists - then readConfig defaultConfigFile - else return (defaultConfig,[]) + doOpts c o >>= xmobar data Opts = Help | Version |