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
75
76
77
78
79
80
|
--------------------------------------------------------------------------------
module Xanthous.Messages.TemplateSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
import Test.QuickCheck.Instances.Text ()
import Data.List.NonEmpty (NonEmpty(..))
import Data.Function (fix)
--------------------------------------------------------------------------------
import Xanthous.Messages.Template
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Messages.Template"
[ testGroup "parsing"
[ testProperty "literals" $ forAll genLiteral $ \s ->
testParse template s === Right (Literal s)
, parseCase "escaped curlies"
"foo\\{"
$ Literal "foo{"
, parseCase "simple substitution"
"foo {{bar}}"
$ Literal "foo " `Concat` Subst (SubstPath $ "bar" :| [])
, parseCase "substitution with filters"
"foo {{bar | baz}}"
$ Literal "foo "
`Concat` Subst (SubstFilter (SubstPath $ "bar" :| [])
(FilterName "baz"))
, parseCase "substitution with multiple filters"
"foo {{bar | baz | qux}}"
$ Literal "foo "
`Concat` Subst (SubstFilter (SubstFilter (SubstPath $ "bar" :| [])
(FilterName "baz"))
(FilterName "qux"))
, parseCase "two substitutions and a literal"
"{{a}}{{b}}c"
$ Subst (SubstPath $ "a" :| [])
`Concat` Subst (SubstPath $ "b" :| [])
`Concat` Literal "c"
, localOption (QuickCheckTests 10)
$ testProperty "round-trips with ppTemplate" $ \tpl ->
testParse template (ppTemplate tpl) === Right tpl
]
, testBatch $ monoid @Template mempty
, testGroup "rendering"
[ testProperty "rendering literals renders literally"
$ forAll genLiteral $ \s fs vs ->
render fs vs (Literal s) === Right s
, testProperty "rendering substitutions renders substitutions"
$ forAll genPath $ \ident val fs ->
let tpl = Subst (SubstPath ident)
tvs = varsWith ident val
in render fs tvs tpl === Right val
, testProperty "filters filter" $ forAll genPath
$ \ident filterName filterFn val ->
let tpl = Subst (SubstFilter (SubstPath ident) filterName)
fs = mapFromList [(filterName, filterFn)]
vs = varsWith ident val
in render fs vs tpl === Right (filterFn val)
]
]
where
genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary
parseCase name input expected =
testCase name $ testParse template input @?= Right expected
testParse p = over _Left errorBundlePretty . runParser p "<test>"
genIdentifier = pack @Text <$> listOf1 (elements identifierChars)
identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_']
varsWith (p :| []) val = vars [(p, Val val)]
varsWith (phead :| ps) val = vars . pure . (phead ,) . flip fix ps $
\next pth -> case pth of
[] -> Val val
p : ps' -> nested [(p, next ps')]
genPath = (:|) <$> genIdentifier <*> listOf genIdentifier
--
|
