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
|
{-# LANGUAGE OverloadedStrings, OverloadedLists #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE ViewPatterns #-}
module Thermoprint.Printout.BBCodeSpec (spec) where
import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (Property, Discard(..), property)
import Test.QuickCheck.Instances
import Thermoprint.Printout.BBCode
import Thermoprint.Printout
import Data.Text (Text)
import qualified Data.Text.Lazy as TL (pack)
import Data.String (IsString(..))
import Control.Monad (zipWithM_, join)
import Data.Monoid ((<>))
import Data.Function (on)
import Data.Bifunctor
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
instance Eq Block where
(==) = (==) `on` cotext
deriving instance Eq Chunk
instance IsString Line where
fromString = (\(Right l) -> l) . text . TL.pack
spec :: Spec
spec = do
describe "example texts for bbcode" $
zipWithM_ example [1..] examples
describe "cobbcode" $ prop "is inverse to bbcode" bbcodeInv
where
example n (s, ts) = let str = show s
in specify str $ bbcode s == (pOut <$> ts)
bbcodeInv :: Printout -> Property
bbcodeInv (cobbcode -> Left _) = property True
bbcodeInv p@(cobbcode -> Right t) = either (const $ property True) property $ (==) <$> normalize (Right p) <*> normalize (bbcode t)
normalize = (!! 3) . iterate normalize' . first (const ())
where
normalize' t = join' (bbcode <$> (join' $ cobbcode <$> t))
join' :: Either a (Either b c) -> Either () c
join' (Right (Right a)) = Right a
join' _ = Left ()
pOut :: Seq Block -> Printout
pOut = Printout . fmap (Paragraph . pure . Cooked)
examples :: [(Text, Either BBCodeError (Seq Block))]
examples = [ ("Hello World!"
, Right [Line (JuxtaPos ["Hello", HSpace 1, "World!"])])
, ("Hello [hspace width=2/] World!"
, Right [Line (JuxtaPos ["Hello", HSpace 4, "World!"])])
, ("Par1\n\nPar2\n\nPar3 Word2"
, Right [Line ("Par1"), Line ("Par2"), Line (JuxtaPos ["Par3", HSpace 1, "Word2"])])
, ("Par1 [hspace=3/]\n\n[vspace=2/]Par2\n\nPar3 Word2"
, Right [Line (JuxtaPos ["Par1", HSpace 4]), NewlSep [VSpace 2, Line ("Par2")], Line (JuxtaPos ["Par3", HSpace 1, "Word2"])])
, ("[b]B [u]BM[/u][/b] [markup bold=1 underline=1]BM[/markup]"
, Right [Line (JuxtaPos [Markup [Bold] (JuxtaPos ["B",HSpace 1,Markup [Underline] "BM"]),HSpace 1,Markup [Bold,Underline] "BM"])])
]
|
