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 +++++---
 2 files changed, 6 insertions(+), 3 deletions(-)

(limited to 'bbcode/src/Text')

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
-- 
cgit v1.2.3