summaryrefslogtreecommitdiffhomepage
path: root/src/Parsers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Parsers.hs')
-rw-r--r--src/Parsers.hs109
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 ",}"