Lexing tag attributes

1 files changed, 14 insertions, 3 deletions

diff --git a/bbcode/src/Text/BBCode/Lexer.hs b/bbcode/src/Text/BBCode/Lexer.hs
index a7294fe..ad26113 100644
--- a/bbcode/src/Text/BBCode/Lexer.hs
+++ b/bbcode/src/Text/BBCode/Lexer.hs
@@ -14,20 +14,31 @@ import Data.Attoparsec.Text
 import Data.Text (Text)
 import qualified Data.Text as T (singleton)
 
+import Data.Char (isSpace)
+
 import Control.Applicative
 
+import Prelude hiding (takeWhile)
+
 -- | Our lexicographical unit
-data BBToken = BBOpen Text -- ^ Tag open
+data BBToken = BBOpen Text [(Text, Maybe Text)] -- ^ Tag open with attributes
              | BBClose Text -- ^ Tag close
              | BBStr Text -- ^ Content of a tag
              deriving (Eq, Show)
 
 token :: Parser BBToken
 -- ^ Tokenizer
-token = BBClose <$> (string "[/" *> escapedText' [']'] <* string "]")
-        <|> BBOpen <$> (string "[" *> escapedText' [']'] <* string "]")
+token = BBClose <$> ("[/" *> escapedText' [']'] <* "]")
+        <|> BBOpen <$> ("[" *> escapedText' [']', ' ']) <*> (option [] attrs <* "]")
         <|> BBStr <$> escapedText ['[']
 
+attrs :: Parser [(Text, Maybe Text)]
+attrs = (:) <$> (attrs' <* takeWhile isSpace) <*> (option [] $ attrs)
+  where
+    attrs' = (,) <$> escapedText ['=', ']', ' '] <*> optional ("=" *> attrArg)
+    attrArg = "\"" *> escapedText ['"'] <* "\""
+              <|> escapedText [']', ' ']
+
 escapedText :: [Char] -> Parser Text
 -- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@
 --