From a5d285a8b74d2278e8549909d29c01b62dc84424 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 12 Jan 2016 05:07:27 +0000
Subject: Lexing tag attributes

---
 bbcode/src/Text/BBCode.hs       |  2 +-
 bbcode/src/Text/BBCode/Lexer.hs | 17 ++++++++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

(limited to 'bbcode/src')

diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs
index dfa1db7..a6de7b4 100644
--- a/bbcode/src/Text/BBCode.hs
+++ b/bbcode/src/Text/BBCode.hs
@@ -42,7 +42,7 @@ rose = fmap Z.toForest . flip rose' (Z.fromForest [])
     rose' (x:xs) = (>>= rose' xs) . rose'' x
 
     rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node t [])
-    rose'' (BBOpen t) = return . Z.children . Z.insert (Node t [])
+    rose'' (BBOpen t _) = return . Z.children . Z.insert (Node t [])
     rose'' (BBClose t) = close t -- for more pointless
 
     close :: Text -> TreePos Empty Text -> Either TreeError (TreePos Empty Text)
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 @\\@
 --
-- 
cgit v1.2.3