diff options
Diffstat (limited to 'src/Parsers.hs')
| -rw-r--r-- | src/Parsers.hs | 38 |
1 files changed, 22 insertions, 16 deletions
diff --git a/src/Parsers.hs b/src/Parsers.hs index cda7004..dceb4b7 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Parsers @@ -25,7 +25,7 @@ import Runnable import Commands import Actions -import Control.Monad (guard, mzero) +import Control.Monad (guard, mzero, liftM) import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Perm @@ -87,7 +87,7 @@ rawParser c a = do char ':' case reads lenstr of [(len,[])] -> do - guard ((len :: Integer) <= (fromIntegral (maxBound :: Int))) + guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) s <- count (fromIntegral len) anyChar string "/>" return [(Text s, c, a)] @@ -123,7 +123,7 @@ actionParser c act = do return (concat s) toButtons :: String -> [Button] -toButtons s = map (\x -> read [x]) s +toButtons = map (\x -> read [x]) -- | Parsers a string wrapped in a color specification. colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] @@ -180,9 +180,6 @@ 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 _ [] = [] @@ -202,16 +199,17 @@ parseConfig = runParser parseConf fields "Config" . stripComments perms = permute $ Config <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition - <|?> pBorder <|?> pBdColor <|?> pHideOnStart <|?> pAllDesktops - <|?> pOverrideRedirect <|?> pPickBroadest - <|?> pLowerOnStart <|?> pPersistent + <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pHideOnStart + <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest + <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" , "border", "borderColor" ,"template", "position" , "allDesktops", "overrideRedirect", "pickBroadest" - , "hideOnStart", "lowerOnStart", "persistent", "commands" + , "hideOnStart", "lowerOnStart", "persistent", "iconRoot" + , "commands" ] pFont = strField font "font" @@ -227,9 +225,11 @@ parseConfig = runParser parseConf fields "Config" . stripComments pLowerOnStart = readField lowerOnStart "lowerOnStart" pPersistent = readField persistent "persistent" pBorder = readField border "border" + pBdWidth = readField borderWidth "borderWidth" pAllDesktops = readField allDesktops "allDesktops" pOverrideRedirect = readField overrideRedirect "overrideRedirect" pPickBroadest = readField pickBroadest "pickBroadest" + pIconRoot = readField iconRoot "iconRoot" pCommands = field commands "commands" readCommands @@ -249,11 +249,17 @@ parseConfig = runParser parseConf fields "Config" . stripComments readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" - strField e n = field e n . between (strDel "start" n) (strDel "end" n) . - many $ noneOf "\"\n\r" - strDel t n = char '"' <?> strErr t n - strErr t n = "the " ++ t ++ " of the string field " ++ n ++ - " - a double quote (\")." + strField e n = field e n strMulti + + strMulti = scan '"' + where + scan lead = do + spaces + char lead + s <- manyTill anyChar (rowCont <|> unescQuote) + (char '"' >> return s) <|> liftM (s ++) (scan '\\') + rowCont = try $ char '\\' >> string "\n" + unescQuote = lookAhead (noneOf "\\") >> lookAhead (string "\"") wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string) |