diff options
Diffstat (limited to 'src/Parsers.hs')
| -rw-r--r-- | src/Parsers.hs | 109 |
1 files changed, 66 insertions, 43 deletions
diff --git a/src/Parsers.hs b/src/Parsers.hs index d2fa1bf..59a1dc7 100644 --- a/src/Parsers.hs +++ b/src/Parsers.hs @@ -34,44 +34,50 @@ import Graphics.X11.Types (Button) data Widget = Icon String | Text String type ColorString = String +type FontIndex = Int -- | Runs the string parser -parseString :: Config -> String -> IO [(Widget, ColorString, Maybe [Action])] +parseString :: Config -> String -> IO [(Widget, ColorString, FontIndex, Maybe [Action])] parseString c s = - case parse (stringParser (fgColor c) Nothing) "" s of + case parse (stringParser (fgColor c) 0 Nothing) "" s of Left _ -> return [(Text $ "Could not parse string: " ++ s , fgColor c + , 0 , Nothing)] Right x -> return (concat x) allParsers :: ColorString + -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, Maybe [Action])] -allParsers c a = - textParser c a - <|> try (iconParser c a) - <|> try (rawParser c a) - <|> try (actionParser c a) - <|> colorParser a + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +allParsers c f a = + textParser c f a + <|> try (iconParser c f a) + <|> try (rawParser c f a) + <|> try (actionParser c f a) + <|> try (fontParser c a) + <|> colorParser f a -- | Gets the string and combines the needed parsers -stringParser :: String -> Maybe [Action] - -> Parser [[(Widget, ColorString, Maybe [Action])]] -stringParser c a = manyTill (allParsers c a) eof +stringParser :: String -> FontIndex -> Maybe [Action] + -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]] +stringParser c f a = manyTill (allParsers c f a) eof -- | Parses a maximal string without color markup. -textParser :: String -> Maybe [Action] - -> Parser [(Widget, ColorString, Maybe [Action])] -textParser c a = do s <- many1 $ - noneOf "<" <|> - try (notFollowedBy' (char '<') - (try (string "fc=") <|> - try (string "action=") <|> - try (string "/action>") <|> - try (string "icon=") <|> - try (string "raw=") <|> - string "/fc>")) - return [(Text s, c, a)] +textParser :: String -> FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +textParser c f a = do s <- many1 $ + noneOf "<" <|> + try (notFollowedBy' (char '<') + (try (string "fc=") <|> + try (string "fn=") <|> + try (string "action=") <|> + try (string "/action>") <|> + try (string "icon=") <|> + try (string "raw=") <|> + try (string "/fn>") <|> + string "/fc>")) + return [(Text s, c, f, a)] -- | Parse a "raw" tag, which we use to prevent other tags from creeping in. -- The format here is net-string-esque: a literal "<raw=" followed by a @@ -79,9 +85,10 @@ textParser c a = do s <- many1 $ -- a literal ":" as digit-string-terminator, the raw string itself, and -- then a literal "/>". rawParser :: ColorString + -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, Maybe [Action])] -rawParser c a = do + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +rawParser c f a = do string "<raw=" lenstr <- many1 digit char ':' @@ -90,7 +97,7 @@ rawParser c a = do guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) s <- count (fromIntegral len) anyChar string "/>" - return [(Text s, c, a)] + return [(Text s, c, f, a)] _ -> mzero -- | Wrapper for notFollowedBy that returns the result of the first parser. @@ -101,15 +108,15 @@ notFollowedBy' p e = do x <- p notFollowedBy $ try (e >> return '*') return x -iconParser :: String -> Maybe [Action] - -> Parser [(Widget, ColorString, Maybe [Action])] -iconParser c a = do +iconParser :: String -> FontIndex -> Maybe [Action] + -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +iconParser c f a = do string "<icon=" i <- manyTill (noneOf ">") (try (string "/>")) - return [(Icon i, c, a)] + return [(Icon i, c, f, a)] -actionParser :: String -> Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] -actionParser c act = do +actionParser :: String -> FontIndex -> Maybe [Action] -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +actionParser c f act = do string "<action=" command <- choice [between (char '`') (char '`') (many1 (noneOf "`")), many1 (noneOf ">")] @@ -119,17 +126,24 @@ actionParser c act = do a' = case act of Nothing -> Just [a] Just act' -> Just $ a : act' - s <- manyTill (allParsers c a') (try $ string "</action>") + s <- manyTill (allParsers c f a') (try $ string "</action>") return (concat s) toButtons :: String -> [Button] toButtons = map (\x -> read [x]) -- | Parsers a string wrapped in a color specification. -colorParser :: Maybe [Action] -> Parser [(Widget, ColorString, Maybe [Action])] -colorParser a = do +colorParser :: FontIndex -> Maybe [Action] -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +colorParser f a = do c <- between (string "<fc=") (string ">") colors - s <- manyTill (allParsers c a) (try $ string "</fc>") + s <- manyTill (allParsers c f a) (try $ string "</fc>") + return (concat s) + +-- | Parsers a string wrapped in a font specification. +fontParser :: ColorString -> Maybe [Action] -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +fontParser c a = do + f <- between (string "<fn=") (string ">") colors + s <- manyTill (allParsers c (read f) a) (try $ string "</fn>") return (concat s) -- | Parses a color specification (hex or named) @@ -198,23 +212,24 @@ parseConfig = runParser parseConf fields "Config" . stripComments return (x,s) perms = permute $ Config - <$?> pFont <|?> pBgColor <|?> pFgColor <|?> pPosition - <|?> pTextOffset <|?> pIconOffset <|?> pBorder + <$?> pFont <|?> pFontList <|?> pBgColor <|?> pFgColor + <|?> pPosition <|?> pTextOffset <|?> pIconOffset <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pAlpha <|?> pHideOnStart <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate - fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep" - , "border", "borderColor" ,"template", "position" - , "textOffset", "iconOffset" + fields = [ "font", "fontList","bgColor", "fgColor", "sepChar" + , "alignSep" , "border", "borderColor" ,"template" + , "position" , "textOffset", "iconOffset" , "allDesktops", "overrideRedirect", "pickBroadest" , "hideOnStart", "lowerOnStart", "persistent", "iconRoot" , "alpha", "commands" ] pFont = strField font "font" + pFontList = strListField fontList "fontList" pBgColor = strField bgColor "bgColor" pFgColor = strField fgColor "fgColor" pBdColor = strField borderColor "borderColor" @@ -253,7 +268,6 @@ parseConfig = runParser parseConf fields "Config" . stripComments } readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" - strField e n = field e n strMulti strMulti = scan '"' @@ -266,6 +280,15 @@ parseConfig = runParser parseConf fields "Config" . stripComments rowCont = try $ char '\\' >> string "\n" unescQuote = lookAhead (noneOf "\\") >> lookAhead (string "\"") + strListField e n = field e n strList + strList = do + spaces + char '[' + list <- sepBy (strMulti >>= \x -> spaces >> return x) (char ',') + spaces + char ']' + return list + wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string) fieldEnd = many $ space <|> oneOf ",}" |