git.iko.soy/typeable/yaml
on de41665 help sign in
typeable/yaml/test/Data/YamlSpec.hs
534 lines 20 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE TemplateHaskell #-}
7module Data.YamlSpec (main, spec) where
9import qualified Text.Libyaml as Y
10import qualified Data.ByteString.Char8 as B8
12import Test.HUnit hiding (Test, path)
14import qualified Data.Conduit as C
15import qualified Control.Monad.Trans.Resource as C
16import qualified Data.Conduit.List as CL
18import Control.Monad
19import Control.Exception (try, SomeException)
20import Test.Hspec
21import Data.Either.Compat
22import System.Directory (createDirectory, createDirectoryIfMissing)
23import Test.Mockery.Directory
25import qualified Data.Yaml as D
26import qualified Data.Yaml.Pretty as Pretty
27import Data.Yaml (object, array, (.=))
28import Data.Maybe
29import qualified Data.HashMap.Strict as M
30import qualified Data.Text as T
31import Data.Aeson.TH
32import Data.Text (Text)
33import Data.Vector (Vector)
34import qualified Data.Vector as V
35import Data.HashMap.Strict (HashMap)
36import qualified Data.HashMap.Strict as HM
37import System.IO (hClose)
38import System.IO.Temp (withSystemTempFile)
40data TestJSON = TestJSON
41 { string :: Text
42 , number :: Int
43 , anArray :: Vector Text
44 , hash :: HashMap Text Text
45 , extrastring :: Text
46 } deriving (Show, Eq)
48deriveJSON defaultOptions ''TestJSON
50main :: IO ()
51main = hspec spec
53spec :: Spec
54spec = do
55 describe "streaming" $ do
56 it "count scalars with anchor" caseCountScalarsWithAnchor
57 it "count sequences with anchor" caseCountSequencesWithAnchor
58 it "count mappings with anchor" caseCountMappingsWithAnchor
59 it "count aliases" caseCountAliases
60 it "count scalars" caseCountScalars
61 it "largest string" caseLargestString
62 it "encode/decode" caseEncodeDecode
63 it "encode/decode file" caseEncodeDecodeFile
64 it "interleaved encode/decode" caseInterleave
65 it "decode invalid document (without segfault)" caseDecodeInvalidDocument
66 describe "Data.Yaml" $ do
67 it "encode/decode" caseEncodeDecodeData
68 it "encode/decode file" caseEncodeDecodeFileData
69 it "encode/decode files with non-ASCII names" caseEncodeDecodeNonAsciiFileData
70 it "encode/decode strings" caseEncodeDecodeStrings
71 it "decode invalid file" caseDecodeInvalid
72 it "processes datatypes" caseDataTypes
73 describe "Data.Yaml.Pretty" $ do
74 it "encode/decode" caseEncodeDecodeDataPretty
75 it "encode/decode strings" caseEncodeDecodeStringsPretty
76 it "processes datatypes" caseDataTypesPretty
77 describe "Data.Yaml aliases" $ do
78 it "simple scalar alias" caseSimpleScalarAlias
79 it "simple sequence alias" caseSimpleSequenceAlias
80 it "simple mapping alias" caseSimpleMappingAlias
81 it "mapping alias before anchor" caseMappingAliasBeforeAnchor
82 it "mapping alias inside anchor" caseMappingAliasInsideAnchor
83 it "scalar alias overriding" caseScalarAliasOverriding
84 describe "Data.Yaml merge keys" $ do
85 it "test uniqueness of keys" caseAllKeysShouldBeUnique
86 it "test mapping merge" caseSimpleMappingMerge
87 it "test sequence of mappings merging" caseMergeSequence
88 describe "numbers" $ do
89 it "parses as string when quoted" caseQuotedNumber
90 it "parses as number when unquoted" caseUnquotedNumber
91 it "parses as number !!str is present" caseAttribNumber
92 it "integers have no decimals" caseIntegerDecimals
93 describe "booleans" $ do
94 it "parses when all lowercase" caseLowercaseBool
95 it "parses when all uppercase" caseUppercaseBool
96 it "parses when titlecase" caseTitlecaseBool
97 describe "empty input" $ do
98 it "parses as Null" caseEmptyInput
99 it "parses as Null from file" caseEmptyInputFile
100 describe "comment only input" $ do
101 it "parses as Null" caseCommentOnlyInput
102 it "parses as Null from file" caseCommentOnlyInputFile
103 describe "alias stripping" $ do
104 it "works" caseStripAlias
105 describe "nulls" $ do
106 checkNull "null"
107 checkNull "Null"
108 checkNull "NULL"
109 checkNull "~"
110 checkNull ""
112 describe "pretty output" $ do
113 it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"
114 it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"
115 it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"
116 it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"
117 it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"
119 describe "special keys" $ do
120 let tester key = it (T.unpack key) $
121 let value = object [key .= True]
122 in D.decode (D.encode value) `shouldBe` Just value
123 mapM_ tester specialStrings
125 describe "special values" $ do
126 let tester value = it (T.unpack value) $
127 let value' = object ["foo" .= value]
128 in D.decode (D.encode value') `shouldBe` Just value'
129 mapM_ tester specialStrings
131 describe "decodeFileEither" $ do
132 it "loads YAML through JSON into Haskell data" $ do
133 tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"
134 tj `shouldBe` TestJSON
135 { string = "str"
136 , number = 2
137 , anArray = V.fromList ["a", "b"]
138 , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]
139 , extrastring = "1234-foo"
140 }
142 context "when file does not exist" $ do
143 it "returns Left" $ do
144 (D.decodeFileEither "./does_not_exist.yaml" :: IO (Either D.ParseException D.Value)) >>= (`shouldSatisfy` isLeft)
147 describe "round-tripping of special scalars" $ do
148 let special = words "y Y On ON false 12345 12345.0 12345a 12e3"
149 forM_ special $ \w -> it w $
150 let v = object ["word" .= w]
151 in D.decode (D.encode v) `shouldBe` Just v
152 it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n"
154 it "aliases in keys #49" caseIssue49
156 it "serialization of +123 #64" $ do
157 D.decode (D.encode ("+123" :: String)) `shouldBe` Just ("+123" :: String)
159 it "preserves Scientific precision" casePreservesScientificPrecision
161 it "truncates files" caseTruncatesFiles
164specialStrings :: [T.Text]
165specialStrings =
166 [ "fo\"o"
167 , "fo\'o"
168 , "fo\\'o"
169 , "fo: o"
170 , "foo\nbar\nbaz\n"
171 ]
173counter :: Monad m => (Y.Event -> Bool) -> C.Sink Y.Event m Int
174counter pred' =
175 CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
177caseHelper :: String
178 -> (Y.Event -> Bool)
179 -> Int
180 -> Assertion
181caseHelper yamlString pred' expRes = do
182 res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'
183 res @?= expRes
185caseCountScalarsWithAnchor :: Assertion
186caseCountScalarsWithAnchor =
187 caseHelper yamlString isScalarA 1
188 where
189 yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
190 isScalarA (Y.EventScalar _ _ _ (Just _)) = True
191 isScalarA _ = False
193caseCountSequencesWithAnchor :: Assertion
194caseCountSequencesWithAnchor =
195 caseHelper yamlString isSequenceStartA 1
196 where
197 yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
198 isSequenceStartA (Y.EventSequenceStart (Just _)) = True
199 isSequenceStartA _ = False
201caseCountMappingsWithAnchor :: Assertion
202caseCountMappingsWithAnchor =
203 caseHelper yamlString isMappingA 1
204 where
205 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
206 isMappingA (Y.EventMappingStart (Just _)) = True
207 isMappingA _ = False
209caseCountAliases :: Assertion
210caseCountAliases =
211 caseHelper yamlString isAlias 1
212 where
213 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
214 isAlias Y.EventAlias{} = True
215 isAlias _ = False
217caseCountScalars :: Assertion
218caseCountScalars = do
219 res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum
220 res @?= (7, 1, 2)
221 where
222 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
223 yamlBS = B8.pack yamlString
224 adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)
225 adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
226 adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)
227 adder a _ = a
228 accum = (0, 0, 0) :: (Int, Int, Int)
230caseLargestString :: Assertion
231caseLargestString = do
232 res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum
233 res @?= (length expected, expected)
234 where
235 expected = "this one is just a little bit bigger than the others"
236 filePath = "test/largest-string.yaml"
237 adder (i, s) (Y.EventScalar bs _ _ _) =
238 let s' = B8.unpack bs
239 i' = length s'
240 in if i' > i then (i', s') else (i, s)
241 adder acc _ = acc
242 accum = (0, "no strings found")
244newtype MyEvent = MyEvent Y.Event deriving Show
245instance Eq MyEvent where
246 (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
247 s == s' && t == t'
248 MyEvent e1 == MyEvent e2 = e1 == e2
250caseEncodeDecode :: Assertion
251caseEncodeDecode = do
252 eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume
253 bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode
254 eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume
255 map MyEvent eList @=? map MyEvent eList2
256 where
257 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
258 yamlBS = B8.pack yamlString
260caseEncodeDecodeFile :: Assertion
261caseEncodeDecodeFile = withFile "" $ \tmpPath -> do
262 eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
263 C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath
264 eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
265 map MyEvent eList @=? map MyEvent eList2
266 where
267 filePath = "test/largest-string.yaml"
269caseInterleave :: Assertion
270caseInterleave = withFile "" $ \tmpPath -> withFile "" $ \tmpPath2 -> do
271 () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath
272 () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2
273 f1 <- readFile tmpPath
274 f2 <- readFile tmpPath2
275 f1 @=? f2
276 where
277 filePath = "test/largest-string.yaml"
279caseDecodeInvalidDocument :: Assertion
280caseDecodeInvalidDocument = do
281 x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull
282 case x of
283 Left (_ :: SomeException) -> return ()
284 Right y -> do
285 putStrLn $ "bad return value: " ++ show y
286 assertFailure "expected parsing exception, but got no errors"
287 where
288 yamlString = " - foo\n - baz\nbuz"
289 yamlBS = B8.pack yamlString
291mkScalar :: String -> D.Value
292mkScalar = mkStrScalar
294mkStrScalar :: String -> D.Value
295mkStrScalar = D.String . T.pack
297mappingKey :: D.Value-> String -> D.Value
298mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)
299mappingKey _ _ = error "expected Object"
301decodeYaml :: String -> Maybe D.Value
302decodeYaml s = D.decode $ B8.pack s
304sample :: D.Value
305sample = array
306 [ D.String "foo"
307 , object
308 [ ("bar1", D.String "bar2")
309 , ("bar3", D.String "")
310 ]
311 , D.String ""
312 ]
314caseEncodeDecodeData :: Assertion
315caseEncodeDecodeData = do
316 let out = D.decode $ D.encode sample
317 out @?= Just sample
319caseEncodeDecodeDataPretty :: Assertion
320caseEncodeDecodeDataPretty = do
321 let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample
322 out @?= Just sample
324caseEncodeDecodeFileData :: Assertion
325caseEncodeDecodeFileData = withFile "" $ \fp -> do
326 D.encodeFile fp sample
327 out <- D.decodeFile fp
328 out @?= Just sample
330caseEncodeDecodeNonAsciiFileData :: Assertion
331caseEncodeDecodeNonAsciiFileData = do
332 let mySample = (object ["foo" .= True])
333 inTempDirectory $ do
334 createDirectory "accenté"
335 D.encodeFile "accenté/bar.yaml" mySample
336 out1 <- D.decodeFile "accenté/bar.yaml"
337 out1 @?= Just mySample
339 createDirectoryIfMissing True "test/resources/accenté/"
341 readFile "test/resources/accent/foo.yaml" >>=
342 writeFile "test/resources/accenté/foo.yaml"
343 out2 <- D.decodeFile "test/resources/accenté/foo.yaml"
344 out2 @?= Just mySample
346caseEncodeDecodeStrings :: Assertion
347caseEncodeDecodeStrings = do
348 let out = D.decode $ D.encode sample
349 out @?= Just sample
351caseEncodeDecodeStringsPretty :: Assertion
352caseEncodeDecodeStringsPretty = do
353 let out = D.decode $ Pretty.encodePretty Pretty.defConfig sample
354 out @?= Just sample
356caseDecodeInvalid :: Assertion
357caseDecodeInvalid = do
358 let invalid = B8.pack "\tthis is 'not' valid :-)"
359 Nothing @=? (D.decode invalid :: Maybe D.Value)
361caseSimpleScalarAlias :: Assertion
362caseSimpleScalarAlias = do
363 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"
364 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
365 let res = fromJust maybeRes
366 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
368caseSimpleSequenceAlias :: Assertion
369caseSimpleSequenceAlias = do
370 let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"
371 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
372 let res = fromJust maybeRes
373 res @?= object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]
375caseSimpleMappingAlias :: Assertion
376caseSimpleMappingAlias = do
377 let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"
378 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
379 let res = fromJust maybeRes
380 res @?= object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]
382caseMappingAliasBeforeAnchor :: Assertion
383caseMappingAliasBeforeAnchor = do
384 let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"
385 isNothing res @? "decode should return Nothing due to unknown alias"
387caseMappingAliasInsideAnchor :: Assertion
388caseMappingAliasInsideAnchor = do
389 let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"
390 isNothing res @? "decode should return Nothing due to unknown alias"
392caseScalarAliasOverriding :: Assertion
393caseScalarAliasOverriding = do
394 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"
395 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
396 let res = fromJust maybeRes
397 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]
399caseAllKeysShouldBeUnique :: Assertion
400caseAllKeysShouldBeUnique = do
401 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"
402 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
403 let res = fromJust maybeRes
404 mappingKey res "foo1" @?= (mkScalar "buz")
406caseSimpleMappingMerge :: Assertion
407caseSimpleMappingMerge = do
408 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
409 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
410 let res = fromJust maybeRes
411 mappingKey res "foo1" @?= (mkScalar "foo")
412 mappingKey res "foo3" @?= (mkScalar "fuz")
414caseMergeSequence :: Assertion
415caseMergeSequence = do
416 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 ]"
417 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
418 let res = fromJust maybeRes
419 mappingKey res "foo1" @?= (mkScalar "foo")
420 mappingKey res "k1" @?= (D.String "1")
421 mappingKey res "k2" @?= (D.String "2")
422 mappingKey res "k3" @?= (D.String "4")
424caseDataTypes :: Assertion
425caseDataTypes =
426 D.decode (D.encode val) @?= Just val
427 where
428 val = object
429 [ ("string", D.String "foo")
430 , ("int", D.Number 5)
431 , ("float", D.Number 4.3)
432 , ("true", D.Bool True)
433 , ("false", D.Bool False)
434 , ("null", D.Null)
435 ]
437caseDataTypesPretty :: Assertion
438caseDataTypesPretty =
439 D.decode (Pretty.encodePretty Pretty.defConfig val) @?= Just val
440 where
441 val = object
442 [ ("string", D.String "foo")
443 , ("int", D.Number 5)
444 , ("float", D.Number 4.3)
445 , ("true", D.Bool True)
446 , ("false", D.Bool False)
447 , ("null", D.Null)
448 ]
449caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion
450caseQuotedNumber = D.decode "foo: \"1234\"" @?= Just (object [("foo", D.String "1234")])
451caseUnquotedNumber = D.decode "foo: 1234" @?= Just (object [("foo", D.Number 1234)])
452caseAttribNumber = D.decode "foo: !!str 1234" @?= Just (object [("foo", D.String "1234")])
453caseIntegerDecimals = D.encode (1 :: Int) @?= "1\n...\n"
455obj :: Maybe D.Value
456obj = Just (object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)])
458caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
459caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj
460caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj
461caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj
463caseEmptyInput :: Assertion
464caseEmptyInput = D.decodeEither B8.empty @?= Right D.Null
466caseEmptyInputFile :: Assertion
467caseEmptyInputFile = do
468 out <- D.decodeFileEither "test/resources/empty.yaml"
469 either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
471caseCommentOnlyInput :: Assertion
472caseCommentOnlyInput = D.decodeEither "# comment\n" @?= Right D.Null
474caseCommentOnlyInputFile :: Assertion
475caseCommentOnlyInputFile = do
476 out <- D.decodeFileEither "test/resources/empty2.yaml"
477 either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
479checkNull :: T.Text -> Spec
480checkNull x =
481 it ("null recognized: " ++ show x) assertion
482 where
483 assertion = Just (object [("foo", D.Null)]) @=? D.decode (B8.pack $ "foo: " ++ T.unpack x)
485caseStripAlias :: Assertion
486caseStripAlias =
487 D.decode src @?= Just (object
488 [ "Default" .= object
489 [ "foo" .= (1 :: Int)
490 , "bar" .= (2 :: Int)
491 ]
492 , "Obj" .= object
493 [ "foo" .= (1 :: Int)
494 , "bar" .= (2 :: Int)
495 , "key" .= (3 :: Int)
496 ]
497 ])
498 where
499 src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n"
501caseIssue49 :: Assertion
502caseIssue49 =
503 D.decodeEither src @?= Right (object
504 [ "a" .= object [ "value" .= (1.0 :: Double) ]
505 , "b" .= object [ "value" .= (1.2 :: Double) ]
506 ])
507 where
508 src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2"
510-- | We cannot guarantee this before aeson started using 'Scientific'.
511casePreservesScientificPrecision :: Assertion
512casePreservesScientificPrecision = do
513 D.decodeEither "x: 1e-100000" @?= Right (object
514 [ "x" .= D.Number (read "1e-100000") ])
515 -- Note that this ought to work also without 'Scientific', given
516 -- that @read (show "9.78159610558926e-5") == 9.78159610558926e-5@.
517 -- However, it didn't work (and still doesn't work with aeson < 0.7)
518 -- for two reasons:
519 --
520 -- * We use 'Data.Text.Read.double', which is not as accurate as it
521 -- can be;
522 -- * Even if we used 'Data.Text.Read.rational' we would not get good
523 -- results, because of <https://github.com/bos/text/issues/34>.
524 D.decodeEither "x: 9.78159610558926e-5" @?= Right (object
525 [ "x" .= D.Number (read "9.78159610558926e-5") ])
527caseTruncatesFiles :: Assertion
528caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do
529 replicateM_ 500 $ B8.hPut h "HELLO WORLD!!!!!\n"
530 hClose h
531 let val = object ["hello" .= ("world" :: String)]
532 D.encodeFile fp val
533 res <- D.decodeFileEither fp
534 either (Left . show) Right res `shouldBe` Right val