forked from snoyberg/data-object-yaml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
runtests.hs
177 lines (144 loc) · 6.86 KB
/
runtests.hs
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
{-# LANGUAGE NamedFieldPuns #-}
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
import Data.Maybe
import qualified Data.ByteString.Char8 as B8
import Data.Convertible.Text (cs)
import qualified Text.Libyaml as LY
import Data.Object
import Data.Object.Yaml
import Control.Monad
mkFoldedScalar :: String -> YamlScalar
mkFoldedScalar s = YamlScalar (cs s) LY.StrTag LY.Folded
mkScalar :: String -> YamlScalar
mkScalar s = YamlScalar (cs s) LY.NoTag LY.Plain
mkStrScalar :: String -> YamlScalar
mkStrScalar s = YamlScalar (cs s) LY.StrTag LY.Plain
mappingKey :: YamlObject -> String -> YamlObject
mappingKey (Mapping m) k = (fromJust . lookup (mkScalar k) $ m)
mappingKey _ _ = error "expected Mapping"
decodeYaml :: String -> Maybe YamlObject
decodeYaml s = decode $ B8.pack s
sample :: YamlObject
sample = Sequence
[ Scalar $ mkFoldedScalar "foo"
, Mapping
[ (mkFoldedScalar "bar1", Scalar $ mkFoldedScalar "bar2")
]
]
sampleStr :: Object String String
sampleStr = mapKeysValues fromYamlScalar fromYamlScalar sample
main :: IO ()
main = defaultMain
[ testSuite
, testSuiteOfAliases
, testSuiteOfMergeKeys
]
testSuite :: Test
testSuite = testGroup "Data.Object.Yaml"
[ testCase "encode/decode" caseEncodeDecode
, testCase "encode/decode file" caseEncodeDecodeFile
, testCase "encode/decode strings" caseEncodeDecodeStrings
, testCase "decode invalid file" caseDecodeInvalid
, testCase "encode/decode in order" caseInOrder
]
caseEncodeDecode :: Assertion
caseEncodeDecode = do
out <- decode $ encode sample
out @?= sample
caseEncodeDecodeFile :: Assertion
caseEncodeDecodeFile = do
let fp = "tmp.yaml"
encodeFile fp sample
out <- join $ decodeFile fp
out @?= sample
caseEncodeDecodeStrings :: Assertion
caseEncodeDecodeStrings = do
out <- decode $ encode $ toYamlObject sampleStr
fromYamlObject out @?= sampleStr
caseDecodeInvalid :: Assertion
caseDecodeInvalid = do
let invalid = B8.pack "\tthis is 'not' valid :-)"
Nothing @=? (decode invalid :: Maybe YamlObject)
testSuiteOfAliases :: Test
testSuiteOfAliases = testGroup "Tests of aliases"
[ testCase "simple scalar alias" caseSimpleScalarAlias
, testCase "simple sequence alias" caseSimpleSequenceAlias
, testCase "simple mapping alias" caseSimpleMappingAlias
, testCase "mapping alias before anchor" caseMappingAliasBeforeAnchor
, testCase "mapping alias inside anchor" caseMappingAliasInsideAnchor
, testCase "scalar alias overriding" caseScalarAliasOverriding
]
caseSimpleScalarAlias :: Assertion
caseSimpleScalarAlias = do
let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
res @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (mkScalar "foo")]
caseSimpleSequenceAlias :: Assertion
caseSimpleSequenceAlias = do
let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
res @?= Mapping [(mkScalar "seq", Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz")]), (mkScalar "seq2", Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz")])]
caseSimpleMappingAlias :: Assertion
caseSimpleMappingAlias = do
let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
res @?= Mapping [(mkScalar "map", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (mkScalar "baz"))]), (mkScalar "map2", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (mkScalar "baz"))])]
caseMappingAliasBeforeAnchor :: Assertion
caseMappingAliasBeforeAnchor = do
let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"
isNothing res @? "decode should return Nothing due to unknown alias"
caseMappingAliasInsideAnchor :: Assertion
caseMappingAliasInsideAnchor = do
let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"
isNothing res @? "decode should return Nothing due to unknown alias"
caseScalarAliasOverriding :: Assertion
caseScalarAliasOverriding = do
let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
res @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (mkScalar "foo"), Scalar (mkScalar "boo"), Scalar (mkScalar "buz"), Scalar (mkScalar "boo")]
testSuiteOfMergeKeys :: Test
testSuiteOfMergeKeys = testGroup "Tests of 'merge keys' feature"
[ testCase "test uniqueness of keys" caseAllKeysShouldBeUnique
, testCase "test mapping merge" caseSimpleMappingMerge
, testCase "test sequence of mappings merging" caseMergeSequence
]
caseAllKeysShouldBeUnique :: Assertion
caseAllKeysShouldBeUnique = do
let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
mappingKey res "foo1" @?= Scalar (mkScalar "buz")
caseSimpleMappingMerge :: Assertion
caseSimpleMappingMerge = do
let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
mappingKey res "foo1" @?= Scalar (mkScalar "foo")
mappingKey res "foo3" @?= Scalar (mkScalar "fuz")
caseMergeSequence :: Assertion
caseMergeSequence = do
let maybeRes = decodeYaml "m1: &m1\n k1: !!str 1\n k2: !!str 2\nm2: &m2\n k1: !!str 3\n k3: !!str 4\nfoo1: foo\n<<: [ *m1, *m2 ]"
isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
let res = fromJust maybeRes
mappingKey res "foo1" @?= Scalar (mkScalar "foo")
mappingKey res "k1" @?= Scalar (mkStrScalar "1")
mappingKey res "k2" @?= Scalar (mkStrScalar "2")
mappingKey res "k3" @?= Scalar (mkStrScalar "4")
inOrderData :: String
inOrderData = "'Fatal': 'Unknown variable \"bar\"'\n'Date': '2001-11-23 15:03:17 -5'\n'User': 'ed'\n'Stack':\n- 'line': '23'\n 'file': 'TopClass.py'\n 'code': 'x = MoreObject(\"345\\n\")\n\n'\n- 'line': '58'\n 'file': 'MoreClass.py'\n 'code': 'foo = bar'\n"
inOrderData2 :: String
inOrderData2 =
"'a': '1'\n'b': '2'\n'd': '4'\n'c': '3'\n"
++ "'g': '1'\n'n': '2'\n'q': '4'\n'f': '3'\n"
++ "'z': '1'\n'y': '2'\n'x': '4'\n'w': '3'\n"
caseInOrder :: Assertion
caseInOrder = do
Just (Mapping ((x, _):_)) <- return $ decodeYaml inOrderData
x @?= mkScalar "Fatal"
fmap (B8.unpack . encode) (decodeYaml inOrderData2) @?= Just inOrderData2