1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
{-# 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 Test.QuickCheck.Instances
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[/t]"])
, ("[\\t]test[/t]"
, [BBOpen "\\t", BBStr "test", BBClose "t"])
, ("[t]test[/t\\]]"
, [BBOpen "t", BBStr "test", BBClose "t]"])
]
|
