From 1bd14813d4210104c44a3925d4e1f585ba1c3303 Mon Sep 17 00:00:00 2001
From: nzeh <nzeh@cs.dal.ca>
Date: Tue, 24 Mar 2009 01:17:59 +0100
Subject: Handle nested colour tags

Parsers.parseString now handles nested colour tags.

darcs-hash:20090324001759-c6b6b-22f00082195fa8bebc90bf55266a2a7dd3069ce8.gz
---
 Parsers.hs | 43 ++++++++++++++++++++++++++-----------------
 1 file changed, 26 insertions(+), 17 deletions(-)

diff --git a/Parsers.hs b/Parsers.hs
index c87aa99..e09c4bf 100644
--- a/Parsers.hs
+++ b/Parsers.hs
@@ -26,27 +26,36 @@ import qualified Data.Map as Map
 -- | Runs the string parser
 parseString :: Config -> String -> IO [(String, String)]
 parseString c s =
-    case parse (stringParser c) "" s of
+    case parse (stringParser (fgColor c)) "" s of
       Left  _ -> return [("Could not parse string: " ++ s, fgColor c)]
       Right x -> return (concat x)
 
 -- | Gets the string and combines the needed parsers
-stringParser :: Config -> Parser [[(String, String)]]
-stringParser = flip manyTill eof . colorParser
-
--- | Parses a string with the default color (no color set)
-colorParser :: Config -> Parser [(String, String)]
-colorParser c = do
-  s <- manyTill anyChar (tryString "<fc" <|> endOfLine "")
-  n <- colorsAndText <|> endOfLine ("","")
-  return [(s,fgColor c),n]
-
--- | Parses a string with a color set
-colorsAndText :: Parser (String, String)
-colorsAndText = do
-  c <- inside (string "=") colors (string ">")
-  s <- manyTill anyChar (tryString "</fc>")
-  return (s,c)
+stringParser :: String -> Parser [[(String, String)]]
+stringParser c = manyTill (textParser c <|> colorParser) eof
+
+-- | Parses a maximal string without color markup.
+textParser :: String -> Parser [(String, String)]
+textParser c = do s <- many1 $
+                    noneOf "<" <|>
+                    ( try $ notFollowedBy' (char '<')
+                                           (string "fc=" <|> string "/fc>" ) )
+                  return [(s, c)]
+
+-- | Wrapper for notFollowedBy that returns the result of the first parser.
+--   Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy
+--   accepts only parsers with return type Char.
+notFollowedBy' :: Parser a -> Parser b -> Parser a
+notFollowedBy' p e = do x <- p
+                        notFollowedBy (e >> return '*')
+                        return x
+
+-- | Parsers a string wrapped in a color specification.
+colorParser :: Parser [(String, String)]
+colorParser = do
+  c <- between (string "<fc=") (string ">") colors
+  s <- manyTill (textParser c <|> colorParser) (try $ string "</fc>")
+  return (concat s)
 
 -- | Parses a color specification (hex or named)
 colors :: Parser String
-- 
cgit v1.2.3