From 9f58557a76b5ae5478a7b7fc9e83266cd215c448 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 12 Jan 2016 10:20:51 +0100 Subject: Selfclosing tags --- bbcode/src/Text/BBCode/Lexer.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'bbcode/src/Text/BBCode') 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