diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-15 01:22:56 +0000 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-15 01:22:56 +0000 |
commit | ca9d7f5b760cb3d56d7785b357590f54ede5b469 (patch) | |
tree | 2eb2e60e196c80b227320dbbda8fe0aa7815296d /bbcode/src/Text/BBCode | |
parent | 848d2a3df2d555cf10eeff275cba2091f6b5b64c (diff) | |
download | thermoprint-ca9d7f5b760cb3d56d7785b357590f54ede5b469.tar thermoprint-ca9d7f5b760cb3d56d7785b357590f54ede5b469.tar.gz thermoprint-ca9d7f5b760cb3d56d7785b357590f54ede5b469.tar.bz2 thermoprint-ca9d7f5b760cb3d56d7785b357590f54ede5b469.tar.xz thermoprint-ca9d7f5b760cb3d56d7785b357590f54ede5b469.zip |
BBCode now understands paragraphs
Diffstat (limited to 'bbcode/src/Text/BBCode')
-rw-r--r-- | bbcode/src/Text/BBCode/Lexer.hs | 14 |
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) | |||
17 | import Data.Char (isSpace) | 17 | import Data.Char (isSpace) |
18 | 18 | ||
19 | import Control.Applicative | 19 | import Control.Applicative |
20 | import Control.Monad (liftM2) | ||
21 | |||
22 | import Data.Monoid | ||
20 | 23 | ||
21 | import Prelude hiding (takeWhile) | 24 | import 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 | ||
30 | token :: Parser BBToken | 34 | token :: Parser BBToken |
@@ -32,7 +36,11 @@ token :: Parser BBToken | |||
32 | token = BBClose <$> ("[/" *> escapedText' [']'] <* "]") | 36 | token = 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 | ||
37 | openTag :: Parser (Text, [(Text, Text)]) | 45 | openTag :: Parser (Text, [(Text, Text)]) |
38 | openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs' | 46 | openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs' |
@@ -51,11 +59,13 @@ attrs' = option [] attrs | |||
51 | escapedText :: [Char] -> Parser Text | 59 | escapedText :: [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@ |
57 | escapedText [] = takeText | 67 | escapedText [] = takeText |
58 | escapedText cs = recurse $ choice [ takeWhile1 (not . special) | 68 | escapedText cs = recurse $ choice [ takeWhile1 $ not . liftM2 (||) special isEndOfLine |
59 | , escapeSeq | 69 | , escapeSeq |
60 | , escapeChar' | 70 | , escapeChar' |
61 | ] | 71 | ] |