From afa953f5254ee68841e8396816261d3405f93cfb Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Sun, 11 Oct 2009 05:55:41 +0200
Subject: Strip '--' comments in xmobarrc

Ignore-this: f58bb2b32a2257d48c039bb8866b5b65

darcs-hash:20091011035541-1499c-0a4163431ee0000c9cdbd70d15bce44b903ec314.gz
---
 Parsers.hs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

(limited to 'Parsers.hs')

diff --git a/Parsers.hs b/Parsers.hs
index 5fae1d8..0b77940 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -147,16 +147,27 @@ liftM9 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8 -> a9 -> 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
 
+stripComments :: String -> String
+stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines
+    where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else ""
+          strip m ('\\':xss) = case xss of
+                                '\\':xs -> '\\' : strip m xs
+                                _ -> strip m $ drop 1 xss
+          strip m ('"':xs) = '"': strip (not m) xs
+          strip m (x:xs) = x : strip m xs
+          strip _ [] = []
+
 -- | 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" $ do
-                sepEndSpaces ["Config","{"]
-                x <- unWrapParser perms
-                wrapSkip (string "}")
-                eof
-                return x
+parseConfig = parseConf "Config" . stripComments
     where
+      parseConf = parse $ do
+        sepEndSpaces ["Config","{"]
+        x <- unWrapParser perms
+        wrapSkip (string "}")
+        eof
+        return x
       perms = runPermsSep (WrappedParser $ wrapSkip $ string ",") $ liftM9 Config
         <$> withDef font         "font"          strField
         <*> withDef bgColor      "bgColor"       strField
-- 
cgit v1.2.3