From 7514c05975601d5816c696a8072b23142e8f0802 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Mon, 14 Sep 2009 04:39:21 +0200 Subject: Parse config file more intelligently. Ignore-this: 9d6cd7536b6df73f3af44b7a74b826a1 Using parsec and action-permutations, config options may be permuted or left out (to be replaced by the default configuration option). This patch improves forwards compatibility with xmobar (ex. the addition of lowerOnStart broke many configs), and provides some help to find typos in the config. The commands section is still parsed with Read however. darcs-hash:20090914023921-1499c-b73a792ccfafd50d31878e35f928facb50748531.gz --- Main.hs | 7 ++----- Parsers.hs | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- xmobar.cabal | 2 +- 3 files changed, 66 insertions(+), 7 deletions(-) diff --git a/Main.hs b/Main.hs index c8ce30d..44dda60 100644 --- a/Main.hs +++ b/Main.hs @@ -64,11 +64,8 @@ readConfig :: FilePath -> IO Config readConfig f = do file <- fileExist f s <- if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage - case reads s of - [(conf,_)] -> return conf - [] -> error $ f ++ ": configuration file contains errors!\n" ++ usage - _ -> error ("Some problem occured. Aborting...") - + either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err) + return $ parseConfig s -- | Read default configuration file or load the default config readDefaultConfig :: IO Config readDefaultConfig = do diff --git a/Parsers.hs b/Parsers.hs index 8867dba..f03ec8e 100644 --- a/Parsers.hs +++ b/Parsers.hs @@ -15,14 +15,22 @@ module Parsers ( parseString , parseTemplate + , parseConfig ) where import Config import Commands import Runnable -import Text.ParserCombinators.Parsec +import Text.ParserCombinators.Parsec hiding ((<|>)) +import qualified Text.ParserCombinators.Parsec as Parsec 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 hiding (many) + -- | Runs the string parser parseString :: Config -> String -> IO [(String, String)] parseString c s = @@ -99,3 +107,57 @@ combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs allTillSep :: Config -> Parser String allTillSep = many . noneOf . sepChar + +instance Applicative (GenParser tok st) where + pure = return + (<*>) = ap + +instance Alternative (GenParser tok st) where + (<|>) x y = (Parsec.<|>) (try x) y + empty = pzero + +readsToParsec :: Read b => CharParser st b +readsToParsec = do + pos0 <- getPosition + input <- getInput + case reads input of + (result,rest):_ -> do + sequenceA_ $ do + ls <- fmap (lines . fst) . find ((==rest) . snd) + $ zip (inits input) (tails input) + lastLine <- safeLast ls + return $ setPosition + . flip setSourceColumn (length lastLine) + . flip incSourceLine (length ls - 1) $ pos0 + setInput rest + return result + _ -> setInput input >> fail "readsToParsec failed" + +safeLast :: [a] -> Maybe a +safeLast [] = Nothing +safeLast xs = Just (last xs) + +-- | Parse the config +parseConfig :: String -> Either ParseError Config +parseConfig = flip parse "Config" $ sepEndSpaces ["Config","{"] + *> perms<* wrapSkip (string "}") + 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") + + wrapSkip x = many space *> x <* many space + sepEndSpaces = mapM_ (\s -> string s <* many space) + withDef f = optAtom (f defaultConfig) + + 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 diff --git a/xmobar.cabal b/xmobar.cabal index 5298e30..034f0d2 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -54,4 +54,4 @@ executable xmobar build-depends: hinotify cpp-options: -DINOTIFY - build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm + build-depends: X11>=1.3.0, mtl, unix, parsec, filepath, stm, action-permutations==0.0.0.0 -- cgit v1.2.3