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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
{-# Language OverloadedStrings #-}
{-|
Module : FromValueSpec
Description : Exercise various components of FromValue
Copyright : (c) Eric Mertens, 2023
License : ISC
Maintainer : emertens@gmail.com
-}
module FromValueSpec (spec) where
import Control.Applicative ((<|>), empty)
import Control.Monad (when)
import Test.Hspec (it, shouldBe, Spec)
import Toml
import Toml.Schema
import Toml.Syntax (startPos)
humanMatcher :: Matcher l a -> Result String a
humanMatcher m =
case runMatcher m of
Failure e -> Failure (prettyMatchMessage . fmap (const startPos) <$> e)
Success w x -> Success (prettyMatchMessage . fmap (const startPos) <$> w) x
spec :: Spec
spec =
do it "handles one reqKey" $
humanMatcher (parseTable (reqKey "test") () (table ["test" .= Text "val"]))
`shouldBe`
Success [] ("val" :: String)
it "handles one optKey" $
humanMatcher (parseTable (optKey "test") () (table ["test" .= Text "val"]))
`shouldBe`
Success [] (Just ("val" :: String))
it "handles one missing optKey" $
humanMatcher (parseTable (optKey "test") () (table ["nottest" .= Text "val"]))
`shouldBe`
Success ["1:1: unexpected key: nottest in <top-level>"] (Nothing :: Maybe String)
it "handles one missing reqKey" $
humanMatcher (parseTable (reqKey "test") () (table ["nottest" .= Text "val"]))
`shouldBe`
(Failure ["1:1: missing key: test in <top-level>"] :: Result String String)
it "handles one mismatched reqKey" $
humanMatcher (parseTable (reqKey "test") () (table ["test" .= Text "val"]))
`shouldBe`
(Failure ["1:1: expected integer but got string in test"] :: Result String Integer)
it "handles one mismatched optKey" $
humanMatcher (parseTable (optKey "test") () (table ["test" .= Text "val"]))
`shouldBe`
(Failure ["1:1: expected integer but got string in test"] :: Result String (Maybe Integer))
it "handles concurrent errors" $
humanMatcher (parseTable (reqKey "a" <|> empty <|> reqKey "b") () (table []))
`shouldBe`
(Failure ["1:1: missing key: a in <top-level>",
"1:1: missing key: b in <top-level>"] :: Result String Integer)
it "handles concurrent value mismatch" $
let v = "" in
humanMatcher (Left <$> fromValue v <|> empty <|> Right <$> fromValue v)
`shouldBe`
(Failure [
"1:1: expected boolean but got string in <top-level>",
"1:1: expected integer but got string in <top-level>"]
:: Result String (Either Bool Int))
it "doesn't emit an error for empty" $
humanMatcher (parseTable empty () (table []))
`shouldBe`
(Failure [] :: Result String Integer)
it "matches single characters" $
runMatcher (fromValue (Text "x"))
`shouldBe`
Success [] 'x'
it "rejections non-single characters" $
humanMatcher (fromValue (Text "xy"))
`shouldBe`
(Failure ["1:1: expected single character in <top-level>"] :: Result String Char)
it "collects warnings in table matching" $
let pt =
do i1 <- reqKey "k1"
i2 <- reqKey "k2"
let n = i1 + i2
when (odd n) (warnTable "k1 and k2 sum to an odd value")
pure n
in
humanMatcher (parseTable pt () (table ["k1" .= (1 :: Integer), "k2" .= (2 :: Integer)]))
`shouldBe`
Success ["k1 and k2 sum to an odd value in <top-level>"] (3 :: Integer)
it "offers helpful messages when no keys match" $
let pt = pickKey [Key "this" \_ -> pure 'a', Key "." \_ -> pure 'b']
in
humanMatcher (parseTable pt () (table []))
`shouldBe`
(Failure ["1:1: possible keys: this, \".\" in <top-level>"] :: Result String Char)
it "generates an error message on an empty pickKey" $
let pt = pickKey []
in
humanMatcher (parseTable pt () (table []))
`shouldBe`
(Failure [] :: Result String Char)
|
