Output to stdout whenever fields are defaulted in a config.

Ignore-this: 3bf71f10543f14aa17b6b403480bcdde

This is done without a command line flag, but perhaps it should be.

darcs-hash:20090923022835-1499c-d05af3db7816672e8a8cb4987215dcc3f9a96947.gz

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