From ca9d7f5b760cb3d56d7785b357590f54ede5b469 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 15 Jan 2016 01:22:56 +0000
Subject: BBCode now understands paragraphs

---
 bbcode/src/Text/BBCode/Lexer.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

(limited to 'bbcode/src/Text/BBCode')

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)
 import Data.Char (isSpace)
 
 import Control.Applicative
+import Control.Monad (liftM2)
+
+import Data.Monoid
 
 import Prelude hiding (takeWhile)
 
@@ -25,6 +28,7 @@ data BBToken = BBOpen Text [(Text, Text)] -- ^ Tag open with attributes
              | BBContained Text [(Text, Text)] -- ^ Tag open & immediate close with attributes
              | BBClose Text -- ^ Tag close
              | BBStr Text -- ^ Content of a tag
+             | BBNewPar
              deriving (Eq, Show)
 
 token :: Parser BBToken
@@ -32,7 +36,11 @@ token :: Parser BBToken
 token = BBClose <$> ("[/" *> escapedText' [']'] <* "]")
         <|> uncurry BBContained <$ "[" <*> openTag <* "/]"
         <|> uncurry BBOpen <$ "[" <*> openTag <* "]"
-        <|> BBStr <$> escapedText ['[']
+        <|> BBNewPar <$ endOfLine <* many1 endOfLine
+        <|> BBStr <$> paragraph
+  where
+    paragraph = (\a b c -> a <> b <> c) <$> option "" endOfLine' <*> escapedText ['['] <*> option "" paragraph
+    endOfLine' = "\n" <$ endOfLine
 
 openTag :: Parser (Text, [(Text, Text)])
 openTag = (,) <$> escapedText' [']', ' ', '=', '/'] <*> attrs'
@@ -51,11 +59,13 @@ attrs' = option [] attrs
 escapedText :: [Char] -> Parser Text
 -- ^ @escapedText cs@ consumes 'Text' up to (not including) the first occurence of a character from @cs@ that is not escaped using @\\@
 --
+-- Does not consume characters used to indicate linebreaks as determined by `isEndOfLine`
+--
 -- Always consumes at least one character
 --
 -- @\\@ needs to be escaped (prefixed with @\\@) iff it precedes a character from @cs@
 escapedText [] = takeText
-escapedText cs = recurse $ choice [ takeWhile1 (not . special)
+escapedText cs = recurse $ choice [ takeWhile1 $ not . liftM2 (||) special isEndOfLine
                                   , escapeSeq
                                   , escapeChar'
                                   ]
-- 
cgit v1.2.3