BBCode lexer

1 files changed, 68 insertions, 0 deletions

diff --git a/bbcode/test/Text/BBCode/LexerSpec.hs b/bbcode/test/Text/BBCode/LexerSpec.hs
new file mode 100644
index 0000000..8b95874
--- /dev/null
+++ b/bbcode/test/Text/BBCode/LexerSpec.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Text.BBCode.LexerSpec (spec) where
+
+import Test.Hspec
+import Test.Hspec.QuickCheck (prop)
+import Test.QuickCheck (Property, Discard(..), property)
+import Text.BBCode.Lexer
+
+import Data.Text (Text)
+import qualified Data.Text as T (singleton, replace, last, null)
+
+import Data.Monoid ((<>), mconcat, Endo(..))
+
+import Data.Attoparsec.Text (parseOnly, endOfInput)
+
+import Control.Applicative
+import Control.Monad (zipWithM_)
+
+coToken :: BBToken -> Text
+-- ^ Inverse of `token`
+coToken (BBOpen t) = "[" <> escape [']'] t <> "]"
+coToken (BBClose t) = "[/" <> escape [']'] t <> "]"
+coToken (BBStr t) = escape ['['] t
+
+escape :: [Char] -> Text -> Text
+-- ^ Inverse of `escapedText`
+escape xs = endos [ T.replace c' ("\\" <> c') . T.replace ("\\" <> c') ("\\\\" <> c') | c <- xs, let c' = T.singleton c ] . escapeLast
+  where
+    endos = appEndo . mconcat . map Endo
+    escapeLast t
+      | T.null t = ""
+      | T.last t == '\\' = t <> "\\"
+      | otherwise = t
+
+tokenize :: Text -> Either String [BBToken]
+-- ^ Run 'many token' against input
+tokenize = parseOnly (many token <* endOfInput)
+
+spec :: Spec
+spec = do
+  prop "prop_token" prop_token
+  zipWithM_ example [1..] examples
+    where
+      example n (s, ts) = let str = "Example " <> show n
+                          in specify str $ (tokenize s == Right ts)
+
+prop_token :: Text -> Property
+-- ^ prop> (mconcat . map coToken) <$> tokenize x == Right x
+--
+-- Where 'x' is restricted such that `tokenize` succeeds
+prop_token x = discardLeft (((== x) . mconcat . map coToken) <$> tokenize x)
+  where
+    discardLeft = either (const $ property Discard) property
+
+examples :: [(Text, [BBToken])]
+examples = [ ("[t]test[/t]"
+             , [BBOpen "t", BBStr "test", BBClose "t"])
+           , ("[t]te\\st[/t]"
+             , [BBOpen "t", BBStr "te\\st", BBClose "t"])
+           , ("[t]te\\[st[/t]"
+             , [BBOpen "t", BBStr "te[st", BBClose "t"])
+           , ("[\\t]test[/t]"
+             , [BBOpen "\\t", BBStr "test", BBClose "t"])
+           , ("[t]test[/t\\]]"
+             , [BBOpen "t", BBStr "test", BBClose "t]"])
+           ]