From 9f58557a76b5ae5478a7b7fc9e83266cd215c448 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 12 Jan 2016 10:20:51 +0100
Subject: Selfclosing tags

---
 bbcode/src/Text/BBCode.hs            |  1 +
 bbcode/src/Text/BBCode/Lexer.hs      |  8 +++++---
 bbcode/test/Text/BBCode/LexerSpec.hs | 12 ++++++++++++
 3 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/bbcode/src/Text/BBCode.hs b/bbcode/src/Text/BBCode.hs
index 30b1da8..32f74df 100644
--- a/bbcode/src/Text/BBCode.hs
+++ b/bbcode/src/Text/BBCode.hs
@@ -88,6 +88,7 @@ rose = fmap Z.toForest . flip rose' (Z.fromForest [])
 
     rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) [])
     rose'' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
+    rose'' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) [])
     rose'' (BBClose t) = close t -- for more pointless
 
     close :: Text -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel)
diff --git a/bbcode/src/Text/BBCode/Lexer.hs b/bbcode/src/Text/BBCode/Lexer.hs
index 560324b..4ad0792 100644
--- a/bbcode/src/Text/BBCode/Lexer.hs
+++ b/bbcode/src/Text/BBCode/Lexer.hs
@@ -22,6 +22,7 @@ import Prelude hiding (takeWhile)
 
 -- | Our lexicographical unit
 data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes
+             | BBContained Text [(Text, Text)]
              | BBClose Text -- ^ Tag close
              | BBStr Text -- ^ Content of a tag
              deriving (Eq, Show)
@@ -29,19 +30,20 @@ data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes
 token :: Parser BBToken
 -- ^ Tokenizer
 token = BBClose <$> ("[/" *> escapedText' [']'] <* "]")
+        <|> uncurry BBContained <$ "[" <*> openTag <* "/]"
         <|> uncurry BBOpen <$ "[" <*> openTag <* "]"
         <|> BBStr <$> escapedText ['[']
 
 openTag :: Parser (Text, [(Text, Text)])
-openTag = (,) <$> escapedText' [']', ' ', '='] <*> attrs'
+openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs'
 
 attrs :: Parser [(Text, Text)]
 attrs = (:) <$> (namedAttr <|> plainValue) <* takeWhile isSpace <*> attrs'
   where
-    namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' '] <*> option "" ("=" *> attrArg)
+    namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' ', '/'] <*> option "" ("=" *> attrArg)
     plainValue = (,) <$> pure "" <* "=" <*> attrArg
     attrArg = "\"" *> escapedText ['"'] <* "\""
-              <|> escapedText [']', ' ']
+              <|> escapedText [']', ' ', '/']
 
 attrs' :: Parser [(Text, Text)]
 attrs' = option [] attrs
diff --git a/bbcode/test/Text/BBCode/LexerSpec.hs b/bbcode/test/Text/BBCode/LexerSpec.hs
index 5c4b89e..df96d52 100644
--- a/bbcode/test/Text/BBCode/LexerSpec.hs
+++ b/bbcode/test/Text/BBCode/LexerSpec.hs
@@ -95,4 +95,16 @@ examples = [ ("[t]test[/t]"
              , [BBOpen "t" [("attr", "va\"l")], BBStr "test", BBClose "t"])
            , ("[t attr=\"val\"   attr2=\"val2\"  ]test[/t]"
              , [BBOpen "t" [("attr", "val"), ("attr2", "val2")], BBStr "test", BBClose "t"])
+           , ("[br/]"
+             , [BBContained "br" []])
+           , ("[br attr/]"
+             , [BBContained "br" [("attr", "")]])
+           , ("[br=val/]"
+             , [BBContained "br" [("", "val")]])
+           , ("[br attr=val/]"
+             , [BBContained "br" [("attr", "val")]])
+           , ("[br attr=val val2/]"
+             , [BBContained "br" [("attr", "val"), ("val2", "")]])
+           , ("[foo\\/bar]"
+             , [BBOpen "foo/bar" []])
            ]
-- 
cgit v1.2.3