summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Main.hs28
-rw-r--r--Parsers.hs45
2 files changed, 45 insertions, 28 deletions
diff --git a/Main.hs b/Main.hs
index 44dda60..a94c597 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Xmobar.Main
@@ -24,6 +25,8 @@ import Parsers
import Config
import XUtil
+import Data.List (intercalate)
+
import Paths_xmobar (version)
import Data.IORef
import Data.Version (showVersion)
@@ -33,6 +36,8 @@ import System.Exit
import System.Environment
import System.Posix.Files
+import Control.Monad.Writer (MonadWriter,MonadIO,unless,runWriterT)
+
-- $main
-- | The main entry point
@@ -41,9 +46,12 @@ main = do
d <- openDisplay ""
args <- getArgs
(o,file) <- getOpts args
- c <- case file of
- [cfgfile] -> readConfig cfgfile
- _ -> readDefaultConfig
+ (c,defaultings) <- runWriterT $ case file of
+ [cfgfile] -> readConfig cfgfile
+ _ -> readDefaultConfig
+
+ unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: "
+ ++ intercalate "," defaultings
-- listen for ConfigureEvents on the root window, for xrandr support:
rootw <- rootWindow d (defaultScreen d)
@@ -60,18 +68,18 @@ main = do
releaseFont d fs
-- | Reads the configuration files or quits with an error
-readConfig :: FilePath -> IO Config
+readConfig :: (MonadIO m, MonadWriter [String] m) => FilePath -> m Config
readConfig f = do
- file <- fileExist f
- s <- if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage
+ file <- io $ fileExist f
+ s <- io $ 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
+ id $ parseConfig s
-- | Read default configuration file or load the default config
-readDefaultConfig :: IO Config
+readDefaultConfig :: (MonadIO m, MonadWriter [String] m) => m Config
readDefaultConfig = do
- home <- getEnv "HOME"
+ home <- io $ getEnv "HOME"
let path = home ++ "/.xmobarrc"
- f <- fileExist path
+ f <- io $ fileExist path
if f then readConfig path else return defaultConfig
data Opts = Help
diff --git a/Parsers.hs b/Parsers.hs
index f03ec8e..0c157df 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Xmobar.Parsers
@@ -27,9 +28,11 @@ import qualified Data.Map as Map
import Data.Foldable (sequenceA_)
import Data.List (find,inits,tails)
-import Control.Applicative.Permutation(optAtom, runPermsSep)
-import Control.Monad(Monad(return), mapM_, ap)
+import Control.Applicative.Permutation -- (atom, maybeAtom, optAtom, runPermsSep)
+import Control.Monad(Monad(return), mapM_, liftM, ap)
import Control.Applicative hiding (many)
+import Control.Monad.Writer
+import Data.Either
-- | Runs the string parser
parseString :: Config -> String -> IO [(String, String)]
@@ -137,27 +140,33 @@ safeLast :: [a] -> Maybe a
safeLast [] = Nothing
safeLast xs = Just (last xs)
--- | Parse the config
-parseConfig :: String -> Either ParseError Config
+liftM9 :: (Monad m) => (a1 -> a -> a11 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> b) -> m a1 -> m a -> m a11 -> m a2 -> m a3 -> m a4 -> m a5 -> m a6 -> m a7 -> m b
+liftM9 fun a b c d e f g h i = fun `liftM` a `ap` b `ap` c `ap` d `ap` e `ap` f `ap` g `ap` h `ap` i
+
+-- | Parse the config, logging a list of fields that were missing and replaced
+-- by the default definition.
+parseConfig :: MonadWriter [String] m => String -> Either ParseError (m Config)
parseConfig = flip parse "Config" $ sepEndSpaces ["Config","{"]
- *> perms<* wrapSkip (string "}")
+ *> perms <* wrapSkip (string "}") <* eof
where
- perms = runPermsSep (wrapSkip $ string ",") $ Config
- <$> withDef font (strField "font")
- <*> withDef bgColor (strField "bgColor")
- <*> withDef fgColor (strField "fgColor")
- <*> withDef position (field "position" readsToParsec)
- <*> withDef lowerOnStart (field "lowerOnStart" parseEnum)
- <*> withDef commands (field "commands" readsToParsec)
- <*> withDef sepChar (strField "sepChar")
- <*> withDef alignSep (strField "alignSep")
- <*> withDef template (strField "template")
+ perms = runPermsSep (wrapSkip $ string ",") $ liftM9 Config
+ <$> withDef font "font" strField
+ <*> withDef bgColor "bgColor" strField
+ <*> withDef fgColor "fgColor" strField
+ <*> withDef position "position" (field readsToParsec)
+ <*> withDef lowerOnStart "lowerOnStart" (field parseEnum )
+ <*> withDef commands "commands" (field readsToParsec)
+ <*> withDef sepChar "sepChar" strField
+ <*> withDef alignSep "alignSep" strField
+ <*> withDef template "template" strField
wrapSkip x = many space *> x <* many space
sepEndSpaces = mapM_ (\s -> string s <* many space)
- withDef f = optAtom (f defaultConfig)
+
+ withDef ext name parser = optAtom (do tell [name]; return $ ext defaultConfig)
+ (liftM return $ parser name)
parseEnum = choice $ map (\x -> x <$ string (show x)) [minBound .. maxBound]
- strField name = field name $ between (char '"') (char '"') (many1 . satisfy $ (/= '"'))
- field name cont = sepEndSpaces [name,"="] *> cont
+ strField name = flip field name $ between (char '"') (char '"') (many1 . satisfy $ (/= '"'))
+ field cont name = sepEndSpaces [name,"="] *> cont