aboutsummaryrefslogtreecommitdiff
path: root/bbcode/src/Text/BBCode/Lexer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'bbcode/src/Text/BBCode/Lexer.hs')
-rw-r--r--bbcode/src/Text/BBCode/Lexer.hs14
1 files changed, 12 insertions, 2 deletions
diff --git a/bbcode/src/Text/BBCode/Lexer.hs b/bbcode/src/Text/BBCode/Lexer.hs
index 218427d..8bd1446 100644
--- a/bbcode/src/Text/BBCode/Lexer.hs
+++ b/bbcode/src/Text/BBCode/Lexer.hs
@@ -17,6 +17,9 @@ import qualified Data.Text as T (singleton)
17import Data.Char (isSpace) 17import Data.Char (isSpace)
18 18
19import Control.Applicative 19import Control.Applicative
20import Control.Monad (liftM2)
21
22import Data.Monoid
20 23
21import Prelude hiding (takeWhile) 24import Prelude hiding (takeWhile)
22 25
@@ -25,6 +28,7 @@ data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes
25 | BBContained Text [(Text, Text)] -- ^ Tag open & immediate close with attributes 28 | BBContained Text [(Text, Text)] -- ^ Tag open & immediate close with attributes
26 | BBClose Text -- ^ Tag close 29 | BBClose Text -- ^ Tag close
27 | BBStr Text -- ^ Content of a tag 30 | BBStr Text -- ^ Content of a tag
31 | BBNewPar
28 deriving (Eq, Show) 32 deriving (Eq, Show)
29 33
30token :: Parser BBToken 34token :: Parser BBToken
@@ -32,7 +36,11 @@ token :: Parser BBToken
32token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") 36token = BBClose <$> ("[/" *> escapedText' [']'] <* "]")
33 <|> uncurry BBContained <$ "[" <*> openTag <* "/]" 37 <|> uncurry BBContained <$ "[" <*> openTag <* "/]"
34 <|> uncurry BBOpen <$ "[" <*> openTag <* "]" 38 <|> uncurry BBOpen <$ "[" <*> openTag <* "]"
35 <|> BBStr <$> escapedText ['['] 39 <|> BBNewPar <$ endOfLine <* many1 endOfLine
40 <|> BBStr <$> paragraph
41 where
42 paragraph = (\a b c -> a <> b <> c) <$> option "" endOfLine' <*> escapedText ['['] <*> option "" paragraph
43 endOfLine' = "\n" <$ endOfLine
36 44
37openTag :: Parser (Text, [(Text, Text)]) 45openTag :: Parser (Text, [(Text, Text)])
38openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs' 46openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs'
@@ -51,11 +59,13 @@ attrs' = option [] attrs
51escapedText :: [Char] -> Parser Text 59escapedText :: [Char] -> Parser Text
52-- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@ 60-- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@
53-- 61--
62-- Does not consume characters used to indicate linebreaks as determined by `isEndOfLine`
63--
54-- Always consumes at least one character 64-- Always consumes at least one character
55-- 65--
56-- @\\@ needs to be escaped (prefixed with @\\@) iff it precedes a character from @cs@ 66-- @\\@ needs to be escaped (prefixed with @\\@) iff it precedes a character from @cs@
57escapedText [] = takeText 67escapedText [] = takeText
58escapedText cs = recurse $ choice [ takeWhile1 (not . special) 68escapedText cs = recurse $ choice [ takeWhile1 $ not . liftM2 (||) special isEndOfLine
59 , escapeSeq 69 , escapeSeq
60 , escapeChar' 70 , escapeChar'
61 ] 71 ]