aboutsummaryrefslogtreecommitdiff
path: root/bbcode
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-12 10:20:51 +0100
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-12 10:20:51 +0100
commit9f58557a76b5ae5478a7b7fc9e83266cd215c448 (patch)
treeda17f533c9c5979265477ed3fc26c48c15a0ff0c /bbcode
parent478bc6572d3ba508bddf1fdcf697e5a9e56e4055 (diff)
downloadthermoprint-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.hs1
-rw-r--r--bbcode/src/Text/BBCode/Lexer.hs8
-rw-r--r--bbcode/test/Text/BBCode/LexerSpec.hs12
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
24data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes 24data 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
29token :: Parser BBToken 30token :: Parser BBToken
30-- ^ Tokenizer 31-- ^ Tokenizer
31token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") 32token = BBClose <$> ("[/" *> escapedText' [']'] <* "]")
33 <|> uncurry BBContained <$ "[" <*> openTag <* "/]"
32 <|> uncurry BBOpen <$ "[" <*> openTag <* "]" 34 <|> uncurry BBOpen <$ "[" <*> openTag <* "]"
33 <|> BBStr <$> escapedText ['['] 35 <|> BBStr <$> escapedText ['[']
34 36
35openTag :: Parser (Text, [(Text, Text)]) 37openTag :: Parser (Text, [(Text, Text)])
36openTag = (,) <$> escapedText' [']', ' ', '='] <*> attrs' 38openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs'
37 39
38attrs :: Parser [(Text, Text)] 40attrs :: Parser [(Text, Text)]
39attrs = (:) <$> (namedAttr <|> plainValue) <* takeWhile isSpace <*> attrs' 41attrs = (:) <$> (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
46attrs' :: Parser [(Text, Text)] 48attrs' :: Parser [(Text, Text)]
47attrs' = option [] attrs 49attrs' = 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 ]