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 | ] |
