git.iko.soy/typeable/yaml
on 8381f21 help sign in
typeable/yaml/test/main.hs
367 lines 14 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE OverloadedStrings #-}
6import qualified Text.Libyaml as Y
7import qualified Data.ByteString.Char8 as B8
9import Test.HUnit hiding (Test, path)
11import qualified Data.Conduit as C
12import qualified Data.Conduit.List as CL
14import System.Directory
15import Control.Monad
16import Control.Exception (try, SomeException)
17import Test.Hspec
19import qualified Data.Yaml as D
20import Data.Yaml (object, array, (.=))
21import Data.Maybe
22import qualified Data.HashMap.Strict as M
23import qualified Data.Text as T
25main :: IO ()
26main = hspec $ do
27 describe "streaming" $ do
28 it "count scalars with anchor" caseCountScalarsWithAnchor
29 it "count sequences with anchor" caseCountSequencesWithAnchor
30 it "count mappings with anchor" caseCountMappingsWithAnchor
31 it "count aliases" caseCountAliases
32 it "count scalars" caseCountScalars
33 it "largest string" caseLargestString
34 it "encode/decode" caseEncodeDecode
35 it "encode/decode file" caseEncodeDecodeFile
36 it "interleaved encode/decode" caseInterleave
37 it "decode invalid document (without segfault)" caseDecodeInvalidDocument
38 describe "Data.Yaml" $ do
39 it "encode/decode" caseEncodeDecodeData
40 it "encode/decode file" caseEncodeDecodeFileData
41 it "encode/decode strings" caseEncodeDecodeStrings
42 it "decode invalid file" caseDecodeInvalid
43 it "processes datatypes" caseDataTypes
44 describe "Data.Yaml aliases" $ do
45 it "simple scalar alias" caseSimpleScalarAlias
46 it "simple sequence alias" caseSimpleSequenceAlias
47 it "simple mapping alias" caseSimpleMappingAlias
48 it "mapping alias before anchor" caseMappingAliasBeforeAnchor
49 it "mapping alias inside anchor" caseMappingAliasInsideAnchor
50 it "scalar alias overriding" caseScalarAliasOverriding
51 describe "Data.Yaml merge keys" $ do
52 it "test uniqueness of keys" caseAllKeysShouldBeUnique
53 it "test mapping merge" caseSimpleMappingMerge
54 it "test sequence of mappings merging" caseMergeSequence
55 describe "numbers" $ do
56 it "parses as string when quoted" caseQuotedNumber
57 it "parses as number when unquoted" caseUnquotedNumber
58 it "parses as number !!str is present" caseAttribNumber
59 describe "booleans" $ do
60 it "parses when all lowercase" caseLowercaseBool
61 it "parses when all uppercase" caseUppercaseBool
62 it "parses when titlecase" caseTitlecaseBool
63 describe "empty input" $ do
64 it "doesn't crash" caseEmptyInput
65 describe "nulls" $ do
66 checkNull "null"
67 checkNull "Null"
68 checkNull "NULL"
69 checkNull "~"
70 checkNull ""
71 describe "pretty output" $ do
72 it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"
73 it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"
74 it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"
75 it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"
76 it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"
77 describe "special keys" $ do
78 let tester key = it (T.unpack key) $
79 let value = object [key .= True]
80 in D.decode (D.encode value) `shouldBe` Just value
81 mapM_ tester specialStrings
82 describe "special values" $ do
83 let tester value = it (T.unpack value) $
84 let value' = object ["foo" .= value]
85 in D.decode (D.encode value') `shouldBe` Just value'
86 mapM_ tester specialStrings
88specialStrings :: [T.Text]
89specialStrings =
90 [ "fo\"o"
91 , "fo\'o"
92 , "fo\\'o"
93 , "fo: o"
94 , "foo\nbar\nbaz\n"
95 ]
97counter :: Monad m => (Y.Event -> Bool) -> C.Sink Y.Event m Int
98counter pred' =
99 CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
101caseHelper :: String
102 -> (Y.Event -> Bool)
103 -> Int
104 -> Assertion
105caseHelper yamlString pred' expRes = do
106 res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'
107 res @?= expRes
109caseCountScalarsWithAnchor :: Assertion
110caseCountScalarsWithAnchor =
111 caseHelper yamlString isScalarA 1
112 where
113 yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
114 isScalarA (Y.EventScalar _ _ _ (Just _)) = True
115 isScalarA _ = False
117caseCountSequencesWithAnchor :: Assertion
118caseCountSequencesWithAnchor =
119 caseHelper yamlString isSequenceStartA 1
120 where
121 yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
122 isSequenceStartA (Y.EventSequenceStart (Just _)) = True
123 isSequenceStartA _ = False
125caseCountMappingsWithAnchor :: Assertion
126caseCountMappingsWithAnchor =
127 caseHelper yamlString isMappingA 1
128 where
129 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
130 isMappingA (Y.EventMappingStart (Just _)) = True
131 isMappingA _ = False
133caseCountAliases :: Assertion
134caseCountAliases =
135 caseHelper yamlString isAlias 1
136 where
137 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
138 isAlias Y.EventAlias{} = True
139 isAlias _ = False
141caseCountScalars :: Assertion
142caseCountScalars = do
143 res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum
144 res @?= (7, 1, 2)
145 where
146 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
147 yamlBS = B8.pack yamlString
148 adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)
149 adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
150 adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)
151 adder a _ = a
152 accum = (0, 0, 0) :: (Int, Int, Int)
154caseLargestString :: Assertion
155caseLargestString = do
156 res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum
157 res @?= (length expected, expected)
158 where
159 expected = "this one is just a little bit bigger than the others"
160 filePath = "test/largest-string.yaml"
161 adder (i, s) (Y.EventScalar bs _ _ _) =
162 let s' = B8.unpack bs
163 i' = length s'
164 in if i' > i then (i', s') else (i, s)
165 adder acc _ = acc
166 accum = (0, "no strings found")
168newtype MyEvent = MyEvent Y.Event deriving Show
169instance Eq MyEvent where
170 (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
171 s == s' && t == t'
172 MyEvent e1 == MyEvent e2 = e1 == e2
174caseEncodeDecode :: Assertion
175caseEncodeDecode = do
176 eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume
177 bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode
178 eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume
179 map MyEvent eList @=? map MyEvent eList2
180 where
181 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
182 yamlBS = B8.pack yamlString
184removeFile' :: FilePath -> IO ()
185removeFile' fp = do
186 x <- doesFileExist fp
187 when x $ removeFile fp
189caseEncodeDecodeFile :: Assertion
190caseEncodeDecodeFile = do
191 removeFile' tmpPath
192 eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
193 C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath
194 eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
195 map MyEvent eList @=? map MyEvent eList2
196 where
197 filePath = "test/largest-string.yaml"
198 tmpPath = "tmp.yaml"
200caseInterleave :: Assertion
201caseInterleave = do
202 removeFile' tmpPath
203 removeFile' tmpPath2
204 () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath
205 () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2
206 f1 <- readFile tmpPath
207 f2 <- readFile tmpPath2
208 f1 @=? f2
209 where
210 filePath = "test/largest-string.yaml"
211 tmpPath = "tmp.yaml"
212 tmpPath2 = "tmp2.yaml"
214caseDecodeInvalidDocument :: Assertion
215caseDecodeInvalidDocument = do
216 x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull
217 case x of
218 Left (_ :: SomeException) -> return ()
219 Right y -> do
220 putStrLn $ "bad return value: " ++ show y
221 assertFailure "expected parsing exception, but got no errors"
222 where
223 yamlString = " - foo\n - baz\nbuz"
224 yamlBS = B8.pack yamlString
226mkScalar :: String -> D.Value
227mkScalar = mkStrScalar
229mkStrScalar :: String -> D.Value
230mkStrScalar = D.String . T.pack
232mappingKey :: D.Value-> String -> D.Value
233mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)
234mappingKey _ _ = error "expected Object"
236decodeYaml :: String -> Maybe D.Value
237decodeYaml s = D.decode $ B8.pack s
239sample :: D.Value
240sample = array
241 [ D.String "foo"
242 , object
243 [ ("bar1", D.String "bar2")
244 , ("bar3", D.String "")
245 ]
246 , D.String ""
247 ]
249caseEncodeDecodeData :: Assertion
250caseEncodeDecodeData = do
251 let out = D.decode $ D.encode sample
252 out @?= Just sample
254caseEncodeDecodeFileData :: Assertion
255caseEncodeDecodeFileData = do
256 let fp = "tmp.yaml"
257 D.encodeFile fp sample
258 out <- D.decodeFile fp
259 out @?= Just sample
261caseEncodeDecodeStrings :: Assertion
262caseEncodeDecodeStrings = do
263 let out = D.decode $ D.encode sample
264 out @?= Just sample
266caseDecodeInvalid :: Assertion
267caseDecodeInvalid = do
268 let invalid = B8.pack "\tthis is 'not' valid :-)"
269 Nothing @=? (D.decode invalid :: Maybe D.Value)
271caseSimpleScalarAlias :: Assertion
272caseSimpleScalarAlias = do
273 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"
274 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
275 let res = fromJust maybeRes
276 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
278caseSimpleSequenceAlias :: Assertion
279caseSimpleSequenceAlias = do
280 let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"
281 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
282 let res = fromJust maybeRes
283 res @?= object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]
285caseSimpleMappingAlias :: Assertion
286caseSimpleMappingAlias = do
287 let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"
288 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
289 let res = fromJust maybeRes
290 res @?= object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]
292caseMappingAliasBeforeAnchor :: Assertion
293caseMappingAliasBeforeAnchor = do
294 let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"
295 isNothing res @? "decode should return Nothing due to unknown alias"
297caseMappingAliasInsideAnchor :: Assertion
298caseMappingAliasInsideAnchor = do
299 let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"
300 isNothing res @? "decode should return Nothing due to unknown alias"
302caseScalarAliasOverriding :: Assertion
303caseScalarAliasOverriding = do
304 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"
305 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
306 let res = fromJust maybeRes
307 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]
309caseAllKeysShouldBeUnique :: Assertion
310caseAllKeysShouldBeUnique = do
311 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"
312 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
313 let res = fromJust maybeRes
314 mappingKey res "foo1" @?= (mkScalar "buz")
316caseSimpleMappingMerge :: Assertion
317caseSimpleMappingMerge = do
318 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
319 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
320 let res = fromJust maybeRes
321 mappingKey res "foo1" @?= (mkScalar "foo")
322 mappingKey res "foo3" @?= (mkScalar "fuz")
324caseMergeSequence :: Assertion
325caseMergeSequence = do
326 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 ]"
327 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
328 let res = fromJust maybeRes
329 mappingKey res "foo1" @?= (mkScalar "foo")
330 mappingKey res "k1" @?= (D.String "1")
331 mappingKey res "k2" @?= (D.String "2")
332 mappingKey res "k3" @?= (D.String "4")
334caseDataTypes :: Assertion
335caseDataTypes =
336 D.decode (D.encode val) @?= Just val
337 where
338 val = object
339 [ ("string", D.String "foo")
340 , ("int", D.Number 5)
341 , ("float", D.Number 4.3)
342 , ("true", D.Bool True)
343 , ("false", D.Bool False)
344 , ("null", D.Null)
345 ]
347caseQuotedNumber, caseUnquotedNumber, caseAttribNumber :: Assertion
348caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])
349caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])
350caseAttribNumber = D.decode "foo: !!str 1234" @?= Just (object [("foo", D.String "1234")])
352obj :: Maybe D.Value
353obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])
355caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
356caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj
357caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj
358caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj
360caseEmptyInput :: Assertion
361caseEmptyInput = D.decode B8.empty @?= (Nothing :: Maybe D.Value)
363checkNull :: T.Text -> Spec
364checkNull x =
365 it ("null recognized: " ++ show x) assertion
366 where
367 assertion = Just (object [("foo", D.Null)]) @=? D.decode (B8.pack $ "foo: " ++ T.unpack x)