diff options
Diffstat (limited to 'bbcode/src/Text/BBCode')
-rw-r--r-- | bbcode/src/Text/BBCode/Lexer.hs | 8 |
1 files changed, 5 insertions, 3 deletions
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) | |||
22 | 22 | ||
23 | -- | Our lexicographical unit | 23 | -- | Our lexicographical unit |
24 | data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes | 24 | data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes |
25 | | BBContained Text [(Text, Text)] | ||
25 | | BBClose Text -- ^ Tag close | 26 | | BBClose Text -- ^ Tag close |
26 | | BBStr Text -- ^ Content of a tag | 27 | | BBStr Text -- ^ Content of a tag |
27 | deriving (Eq, Show) | 28 | deriving (Eq, Show) |
@@ -29,19 +30,20 @@ data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes | |||
29 | token :: Parser BBToken | 30 | token :: Parser BBToken |
30 | -- ^ Tokenizer | 31 | -- ^ Tokenizer |
31 | token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") | 32 | token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") |
33 | <|> uncurry BBContained <$ "[" <*> openTag <* "/]" | ||
32 | <|> uncurry BBOpen <$ "[" <*> openTag <* "]" | 34 | <|> uncurry BBOpen <$ "[" <*> openTag <* "]" |
33 | <|> BBStr <$> escapedText ['['] | 35 | <|> BBStr <$> escapedText ['['] |
34 | 36 | ||
35 | openTag :: Parser (Text, [(Text, Text)]) | 37 | openTag :: Parser (Text, [(Text, Text)]) |
36 | openTag = (,) <$> escapedText' [']', ' ', '='] <*> attrs' | 38 | openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs' |
37 | 39 | ||
38 | attrs :: Parser [(Text, Text)] | 40 | attrs :: Parser [(Text, Text)] |
39 | attrs = (:) <$> (namedAttr <|> plainValue) <* takeWhile isSpace <*> attrs' | 41 | attrs = (:) <$> (namedAttr <|> plainValue) <* takeWhile isSpace <*> attrs' |
40 | where | 42 | where |
41 | namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' '] <*> option "" ("=" *> attrArg) | 43 | namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' ', '/'] <*> option "" ("=" *> attrArg) |
42 | plainValue = (,) <$> pure "" <* "=" <*> attrArg | 44 | plainValue = (,) <$> pure "" <* "=" <*> attrArg |
43 | attrArg = "\"" *> escapedText ['"'] <* "\"" | 45 | attrArg = "\"" *> escapedText ['"'] <* "\"" |
44 | <|> escapedText [']', ' '] | 46 | <|> escapedText [']', ' ', '/'] |
45 | 47 | ||
46 | attrs' :: Parser [(Text, Text)] | 48 | attrs' :: Parser [(Text, Text)] |
47 | attrs' = option [] attrs | 49 | attrs' = option [] attrs |