summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--Main.hs7
-rw-r--r--Parsers.hs64
-rw-r--r--xmobar.cabal2
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