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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{-# Language DuplicateRecordFields #-}
{-|
Module : DecodeSpec
Description : Show that decoding TOML works using the various provided classes
Copyright : (c) Eric Mertens, 2023
License : ISC
Maintainer : emertens@gmail.com
-}
module DecodeSpec (spec) where
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import QuoteStr (quoteStr)
import Test.Hspec (it, shouldBe, Spec)
import Toml (decode, Result, encode)
import Toml.FromValue (FromValue(..), reqKey, optKey)
import Toml.FromValue.Generic (genericParseTable)
import Toml.ToValue (ToTable(..), ToValue(toValue), table, (.=), defaultTableToValue)
import Toml.ToValue.Generic (genericToTable)
import Toml (Result(..))
import Toml.FromValue (parseTableFromValue)
newtype Fruits = Fruits { fruits :: [Fruit] }
deriving (Eq, Show, Generic)
data Fruit = Fruit {
name :: String,
physical :: Maybe Physical,
varieties :: [Variety]
} deriving (Eq, Show, Generic)
data Physical = Physical {
color :: String,
shape :: String
} deriving (Eq, Show, Generic)
newtype Variety = Variety {
name :: String
} deriving (Eq, Show, Generic)
instance FromValue Fruits where fromValue = parseTableFromValue genericParseTable
instance FromValue Physical where fromValue = parseTableFromValue genericParseTable
instance FromValue Variety where fromValue = parseTableFromValue genericParseTable
instance ToTable Fruits where toTable = genericToTable
instance ToTable Physical where toTable = genericToTable
instance ToTable Variety where toTable = genericToTable
instance ToValue Fruits where toValue = defaultTableToValue
instance ToValue Fruit where toValue = defaultTableToValue
instance ToValue Physical where toValue = defaultTableToValue
instance ToValue Variety where toValue = defaultTableToValue
instance FromValue Fruit where
fromValue = parseTableFromValue (Fruit
<$> reqKey "name"
<*> optKey "physical"
<*> (fromMaybe [] <$> optKey "varieties"))
instance ToTable Fruit where
toTable (Fruit n mbp vs) = table $
["varieties" .= vs | not (null vs)] ++
["physical" .= p | Just p <- [mbp]] ++
["name" .= n]
spec :: Spec
spec =
do let expect = Fruits [
Fruit "apple" (Just (Physical "red" "round")) [Variety "red delicious", Variety "granny smith"],
Fruit "banana" Nothing [Variety "plantain"]]
it "handles fruit example" $
decode [quoteStr|
[[fruits]]
name = "apple"
[fruits.physical] # subtable
color = "red"
shape = "round"
[[fruits.varieties]] # nested array of tables
name = "red delicious"
[[fruits.varieties]]
name = "granny smith"
[[fruits]]
name = "banana"
[[fruits.varieties]]
name = "plantain"|]
`shouldBe`
Success mempty expect
it "encodes correctly" $
show (encode expect)
`shouldBe`
[quoteStr|
[[fruits]]
name = "apple"
[fruits.physical]
color = "red"
shape = "round"
[[fruits.varieties]]
name = "red delicious"
[[fruits.varieties]]
name = "granny smith"
[[fruits]]
name = "banana"
[[fruits.varieties]]
name = "plantain"|]
it "generates warnings for unused keys" $
decode [quoteStr|
[[fruits]]
name = "peach"
taste = "sweet"
count = 5
[[fruits]]
name = "pineapple"
color = "yellow"|]
`shouldBe`
Success [
"unexpected keys: count, taste in top.fruits[0]",
"unexpected key: color in top.fruits[1]"]
(Fruits [Fruit "peach" Nothing [], Fruit "pineapple" Nothing []])
it "handles missing key errors" $
(decode "[[fruits]]" :: Result String Fruits)
`shouldBe`
Failure ["missing key: name in top.fruits[0]"]
it "handles parse errors while decoding" $
(decode "x =" :: Result String Fruits)
`shouldBe`
Failure ["1:4: parse error: unexpected end-of-input"]
|
