diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-12 10:20:51 +0100 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-12 10:20:51 +0100 |
commit | 9f58557a76b5ae5478a7b7fc9e83266cd215c448 (patch) | |
tree | da17f533c9c5979265477ed3fc26c48c15a0ff0c /bbcode | |
parent | 478bc6572d3ba508bddf1fdcf697e5a9e56e4055 (diff) | |
download | thermoprint-9f58557a76b5ae5478a7b7fc9e83266cd215c448.tar thermoprint-9f58557a76b5ae5478a7b7fc9e83266cd215c448.tar.gz thermoprint-9f58557a76b5ae5478a7b7fc9e83266cd215c448.tar.bz2 thermoprint-9f58557a76b5ae5478a7b7fc9e83266cd215c448.tar.xz thermoprint-9f58557a76b5ae5478a7b7fc9e83266cd215c448.zip |
Selfclosing tags
Diffstat (limited to 'bbcode')
-rw-r--r-- | bbcode/src/Text/BBCode.hs | 1 | ||||
-rw-r--r-- | bbcode/src/Text/BBCode/Lexer.hs | 8 | ||||
-rw-r--r-- | 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 []) | |||
88 | 88 | ||
89 | rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) []) | 89 | rose'' (BBStr t) = return . Z.nextSpace . Z.insert (Node (BBPlain t) []) |
90 | rose'' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) []) | 90 | rose'' (BBOpen t attrs) = return . Z.children . Z.insert (Node (BBTag t $ Map.fromList attrs) []) |
91 | rose'' (BBContained t attrs) = return . Z.nextSpace . Z.insert (Node (BBTag t $ Map.fromList attrs) []) | ||
91 | rose'' (BBClose t) = close t -- for more pointless | 92 | rose'' (BBClose t) = close t -- for more pointless |
92 | 93 | ||
93 | close :: Text -> TreePos Empty BBLabel -> Either TreeError (TreePos Empty BBLabel) | 94 | 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) | |||
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 |
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]" | |||
95 | , [BBOpen "t" [("attr", "va\"l")], BBStr "test", BBClose "t"]) | 95 | , [BBOpen "t" [("attr", "va\"l")], BBStr "test", BBClose "t"]) |
96 | , ("[t attr=\"val\" attr2=\"val2\" ]test[/t]" | 96 | , ("[t attr=\"val\" attr2=\"val2\" ]test[/t]" |
97 | , [BBOpen "t" [("attr", "val"), ("attr2", "val2")], BBStr "test", BBClose "t"]) | 97 | , [BBOpen "t" [("attr", "val"), ("attr2", "val2")], BBStr "test", BBClose "t"]) |
98 | , ("[br/]" | ||
99 | , [BBContained "br" []]) | ||
100 | , ("[br attr/]" | ||
101 | , [BBContained "br" [("attr", "")]]) | ||
102 | , ("[br=val/]" | ||
103 | , [BBContained "br" [("", "val")]]) | ||
104 | , ("[br attr=val/]" | ||
105 | , [BBContained "br" [("attr", "val")]]) | ||
106 | , ("[br attr=val val2/]" | ||
107 | , [BBContained "br" [("attr", "val"), ("val2", "")]]) | ||
108 | , ("[foo\\/bar]" | ||
109 | , [BBOpen "foo/bar" []]) | ||
98 | ] | 110 | ] |