From 478bc6572d3ba508bddf1fdcf697e5a9e56e4055 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 12 Jan 2016 09:39:42 +0100 Subject: DomTree --- bbcode/src/Text/BBCode/Lexer.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'bbcode/src/Text/BBCode') diff --git a/bbcode/src/Text/BBCode/Lexer.hs b/bbcode/src/Text/BBCode/Lexer.hs index 03f57d2..560324b 100644 --- a/bbcode/src/Text/BBCode/Lexer.hs +++ b/bbcode/src/Text/BBCode/Lexer.hs @@ -21,7 +21,7 @@ import Control.Applicative import Prelude hiding (takeWhile) -- | Our lexicographical unit -data BBToken = BBOpen Text [(Text, Maybe Text)] -- ^ Tag open with attributes +data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes | BBClose Text -- ^ Tag close | BBStr Text -- ^ Content of a tag deriving (Eq, Show) @@ -32,18 +32,18 @@ token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") <|> uncurry BBOpen <$ "[" <*> openTag <* "]" <|> BBStr <$> escapedText ['['] -openTag :: Parser (Text, [(Text, Maybe Text)]) +openTag :: Parser (Text, [(Text, Text)]) openTag = (,) <$> escapedText' [']', ' ', '='] <*> attrs' -attrs :: Parser [(Text, Maybe Text)] +attrs :: Parser [(Text, Text)] attrs = (:) <$> (namedAttr <|> plainValue) <* takeWhile isSpace <*> attrs' where - namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' '] <*> optional ("=" *> attrArg) - plainValue = (,) <$> pure "" <* "=" <*> (Just <$> attrArg) + namedAttr = (,) <$ takeWhile isSpace <*> escapedText ['=', ']', ' '] <*> option "" ("=" *> attrArg) + plainValue = (,) <$> pure "" <* "=" <*> attrArg attrArg = "\"" *> escapedText ['"'] <* "\"" <|> escapedText [']', ' '] -attrs' :: Parser [(Text, Maybe Text)] +attrs' :: Parser [(Text, Text)] attrs' = option [] attrs escapedText :: [Char] -> Parser Text -- cgit v1.2.3