@@ -1,899 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE PackageImports #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TemplateHaskell #-}
6−{-# LANGUAGE TupleSections #-}
7−
8−module Data.YamlSpec (main, spec) where
9−
10−import qualified Text.Libyaml as Y
11−import qualified Data.ByteString as BS
12−import qualified Data.ByteString.Char8 as B8
13−import Data.Int (Int64)
14−import qualified Data.Scientific as S
15−
16−import Test.HUnit hiding (Test, path)
17−
18−import Data.Conduit (runConduitRes, (.|), ConduitM)
19−import qualified Data.Conduit.List as CL
20−
21−import Control.Monad
22−import Control.Exception (try, SomeException)
23−import Test.Hspec
24−import Test.Hspec.QuickCheck
25−import Data.Either.Compat
26−import System.Directory (createDirectory, createDirectoryIfMissing)
27−import Test.Mockery.Directory
28−
29−import qualified Data.Yaml as D
30−import qualified Data.Yaml.Builder as B
31−import qualified Data.Yaml.Internal as Internal
32−import qualified Data.Yaml.Pretty as Pretty
33−import Data.Yaml (object, array, (.=))
34−import Data.Maybe
35−import qualified Data.HashMap.Strict as HM
36−#if MIN_VERSION_aeson(2,0,0)
37−import qualified Data.Aeson.KeyMap as M
38−import qualified Data.Aeson.Key as K
39−import Data.Aeson.KeyMap (KeyMap)
40−#else
41−import qualified Data.HashMap.Strict as M
42−#endif
43−import qualified Data.Text as T
44−import Data.Aeson.TH
45−import Data.Scientific (Scientific)
46−import Data.String (fromString)
47−import Data.Text (Text)
48−import Data.Text.Encoding (decodeUtf8, encodeUtf8)
49−import Data.Vector (Vector)
50−import qualified Data.Vector as V
51−import Data.HashMap.Strict (HashMap)
52−import qualified Data.HashMap.Strict as HM
53−import System.IO (hClose)
54−import System.IO.Temp (withSystemTempFile)
55−
56−#if MIN_VERSION_aeson(2,0,0)
57−fromText :: T.Text -> K.Key
58−fromText = K.fromText
59−
60−toText :: K.Key -> T.Text
61−toText = K.toText
62−#else
63−fromText :: T.Text -> T.Text
64−fromText = id
65−
66−toText :: Key -> T.Text
67−toText = id
68−
69−type KeyMap a = M.HashMap Text a
70−type Key = Text
71−#endif
72−
73−data TestJSON = TestJSON
74− { string :: Text
75− , number :: Int
76− , anArray :: Vector Text
77− , hash :: HashMap Text Text
78− , extrastring :: Text
79− } deriving (Show, Eq)
80−
81−deriveJSON defaultOptions ''TestJSON
82−
83−testJSON :: TestJSON
84−testJSON = TestJSON
85− { string = "str"
86− , number = 2
87− , anArray = V.fromList ["a", "b"]
88− , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]
89− , extrastring = "1234-foo"
90− }
91−
92−shouldDecode :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> a -> IO ()
93−shouldDecode bs expected = do
94− actual <- D.decodeThrow bs
95− actual `shouldBe` expected
96−
97−shouldDecodeAll :: (Show a, D.FromJSON a, Eq a) => B8.ByteString -> [a] -> IO ()
98−shouldDecodeAll bs expected = do
99− actual <- D.decodeAllThrow bs
100− actual `shouldBe` expected
101−
102−shouldDecodeEvents :: B8.ByteString -> [Y.Event] -> IO ()
103−shouldDecodeEvents bs expected = do
104− actual <- runConduitRes $ Y.decode bs .| CL.consume
105− map anyStyle actual `shouldBe` map anyStyle expected
106−
107−anyStyle :: Y.Event -> Y.Event
108−anyStyle (Y.EventScalar bs tag _ anchor) = Y.EventScalar bs tag Y.Any anchor
109−anyStyle (Y.EventSequenceStart tag _ anchor) = Y.EventSequenceStart tag Y.AnySequence anchor
110−anyStyle (Y.EventMappingStart tag _ anchor) = Y.EventMappingStart tag Y.AnyMapping anchor
111−anyStyle event = event
112−
113−testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString
114−testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts
115−
116−eventStream :: [Y.Event] -> [Y.Event]
117−eventStream events =
118− [Y.EventStreamStart, Y.EventDocumentStart]
119− ++ events
120− ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
121−
122−main :: IO ()
123−main = hspec spec
124−
125−spec :: Spec
126−spec = do
127− describe "streaming" $ do
128− it "count scalars with anchor" caseCountScalarsWithAnchor
129− it "count sequences with anchor" caseCountSequencesWithAnchor
130− it "count mappings with anchor" caseCountMappingsWithAnchor
131− it "count sequences with custom tag" caseCountSequenceTags
132− it "count mappings with custom tag" caseCountMappingTags
133− it "count count sequences with ! tag" caseCountEmptySequenceTags
134− it "count count mappings with ! tag" caseCountEmptyMappingTags
135− it "count block style sequences" caseCountBlockStyleSequences
136− it "count flow style sequences" caseCountFlowStyleSequences
137− it "count block style mappings" caseCountBlockStyleMappings
138− it "count flow style mappings" caseCountFlowStyleMappings
139− it "count aliases" caseCountAliases
140− it "count scalars" caseCountScalars
141− it "largest string" caseLargestString
142− it "encode/decode" caseEncodeDecode
143− it "encode/decode events" caseEncodeDecodeEvents
144− it "encode/decode file" caseEncodeDecodeFile
145− it "interleaved encode/decode" caseInterleave
146− it "decode invalid document (without segfault)" caseDecodeInvalidDocument
147− describe "Data.Yaml" $ do
148− it "encode/decode" caseEncodeDecodeData
149− it "encode/decode file" caseEncodeDecodeFileData
150− it "encode/decode files with non-ASCII names" caseEncodeDecodeNonAsciiFileData
151− it "encode/decode strings" caseEncodeDecodeStrings
152− it "decode invalid file" caseDecodeInvalid
153− it "processes datatypes" caseDataTypes
154− it "encode invalid numbers" caseEncodeInvalidNumbers
155− describe "Data.Yaml.Pretty" $ do
156− it "encode/decode" caseEncodeDecodeDataPretty
157− it "encode/decode strings" caseEncodeDecodeStringsPretty
158− it "processes datatypes" caseDataTypesPretty
159− describe "Data.Yaml.Builder" $ do
160− it "encode/decode" caseEncodeDecodeDataBuilder
161− it "encode/decode complex mapping" caseEncodeDecodeComplexMappingBuilder
162− describe "Data.Yaml aliases" $ do
163− it "simple scalar alias" caseSimpleScalarAlias
164− it "simple sequence alias" caseSimpleSequenceAlias
165− it "simple mapping alias" caseSimpleMappingAlias
166− it "mapping alias before anchor" caseMappingAliasBeforeAnchor
167− it "mapping alias inside anchor" caseMappingAliasInsideAnchor
168− it "scalar alias overriding" caseScalarAliasOverriding
169− describe "Data.Yaml merge keys" $ do
170− it "test uniqueness of keys" caseAllKeysShouldBeUnique
171− it "test mapping merge" caseSimpleMappingMerge
172− it "test sequence of mappings merging" caseMergeSequence
173− describe "numbers" $ do
174− it "parses as string when quoted" caseQuotedNumber
175− it "parses as number when unquoted" caseUnquotedNumber
176− it "parses as number !!str is present" caseAttribNumber
177− it "integers have no decimals" caseIntegerDecimals
178− describe "booleans" $ do
179− it "parses when all lowercase" caseLowercaseBool
180− it "parses when all uppercase" caseUppercaseBool
181− it "parses when titlecase" caseTitlecaseBool
182− describe "empty input" $ do
183− it "parses as Null" caseEmptyInput
184− it "parses as Null from file" caseEmptyInputFile
185− describe "comment only input" $ do
186− it "parses as Null" caseCommentOnlyInput
187− it "parses as Null from file" caseCommentOnlyInputFile
188− describe "alias stripping" $ do
189− it "works" caseStripAlias
190− describe "nulls" $ do
191− checkNull "null"
192− checkNull "Null"
193− checkNull "NULL"
194− checkNull "~"
195− checkNull ""
196−
197− describe "pretty output" $ do
198− it "simple nulls" $ D.encode (object ["foo" .= D.Null]) `shouldBe` "foo: null\n"
199− it "simple numbers" $ D.encode (object ["foo" .= (4 :: Int)]) `shouldBe` "foo: 4\n"
200− it "True" $ D.encode (object ["foo" .= True]) `shouldBe` "foo: true\n"
201− it "False" $ D.encode (object ["foo" .= False]) `shouldBe` "foo: false\n"
202− it "simple string" $ D.encode (object ["foo" .= ("bar" :: T.Text)]) `shouldBe` "foo: bar\n"
203− it "*" $ D.encode (object ["foo" .= ("*" :: T.Text)]) `shouldBe` "foo: '*'\n"
204−
205− describe "special keys" $ do
206− let tester key = it (T.unpack key) $
207− let value = object [fromText key .= True]
208− in D.encode value `shouldDecode` value
209− mapM_ tester specialStrings
210−
211− describe "special values" $ do
212− let tester value = it (T.unpack value) $
213− let value' = object ["foo" .= value]
214− in D.encode value' `shouldDecode` value'
215− mapM_ tester specialStrings
216−
217− describe "decodeFileEither" $ do
218− it "loads YAML through JSON into Haskell data" $ do
219− tj <- either (error . show) id `fmap` D.decodeFileEither "test/json.yaml"
220− tj `shouldBe` testJSON
221−
222− context "when file does not exist" $ do
223− it "returns Left" $ do
224− (D.decodeFileEither "./does_not_exist.yaml" :: IO (Either D.ParseException D.Value)) >>= (`shouldSatisfy` isLeft)
225−
226− describe "multiple document support" $ do
227− it "decodes zero-length input" $
228− "" `shouldDecodeAll` ([] :: [D.Value])
229− it "decodes comment-only input" $
230− "# foo\n# bar" `shouldDecodeAll` ([] :: [D.Value])
231− it "decodes a single document stream" $
232− "foo: true" `shouldDecodeAll` [object ["foo" .= True]]
233− it "decodes multiple documents" $
234− "--- 1\n--- 2" `shouldDecodeAll` [D.Number 1, D.Number 2]
235−
236− describe "round-tripping of special scalars" $ do
237− let special = words "y Y On ON false 12345 12345.0 12345a 12e3"
238− forM_ special $ \w -> it w $
239− let v = object ["word" .= w]
240− in D.encode v `shouldDecode` v
241− it "no tags" $ D.encode (object ["word" .= ("true" :: String)]) `shouldBe` "word: 'true'\n"
242−
243− it "aliases in keys #49" caseIssue49
244−
245− it "serialization of +123 #64" $ do
246− D.encode ("+123" :: String) `shouldDecode` ("+123" :: String)
247−
248− it "preserves Scientific precision" casePreservesScientificPrecision
249−
250− it "truncates files" caseTruncatesFiles
251−
252− it "encode quotes special keys #137" $ caseSpecialKeys D.encode
253−
254− it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig)
255−
256− describe "non-decimal numbers #135" $ do
257− let go str val = it str $ encodeUtf8 (T.pack str) `shouldDecode` val
258− go "12345" (12345 :: Int)
259− go "+12345" (12345 :: Int)
260− go "0o14" (12 :: Int)
261− go "0o123" (83 :: Int)
262− go "0xC" (12 :: Int)
263− go "0xc" (12 :: Int)
264− go "0xdeadBEEF" (3735928559 :: Int64)
265− go "0xDEADBEEF" (3735928559 :: Int64)
266− go "1.23015e+3" (1230.15 :: Scientific)
267− go "12.3015e+02" (1230.15 :: Scientific)
268− go "1230.15" (1230.15 :: Scientific)
269−
270− describe "Text.Libyaml with default tag rendering" $ do
271− let enc = testEncodeWith Y.defaultFormatOptions
272− it "elides custom sequence tags" $
273− enc taggedSequence `shouldReturn` "[]\n"
274− it "elides custom mapping tags" $
275− enc taggedMapping `shouldReturn` "{}\n"
276− it "elides default sequence tags" $
277− enc defaultTaggedSequence `shouldReturn` "[]\n"
278− it "elides default mapping tags" $
279− enc defaultTaggedMapping `shouldReturn` "{}\n"
280− it "handles NoTag on sequences" $
281− enc untaggedSequence `shouldReturn` "[]\n"
282− it "handles NoTag on mappings" $
283− enc untaggedMapping `shouldReturn` "{}\n"
284− it "handles mixed tag usages but elides all mapping and sequence tags" $
285− enc mixedTagSampleA `shouldReturn` "- {}\n"
286− it "in combination of tags, anchors and styles, outputs only the scalar tags" $
287− enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c [&d !!null '']\n"
288− it "outputs tags when double quoted" $
289− enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "!!str \"foo\"\n"
290− it "outputs tags when single quoted" $
291− enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "!!str 'foo'\n"
292− it "outputs tags on literal text" $
293− enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "!!str |-\n foo\n"
294− it "outputs tags on folded text" $
295− enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` "!!str >-\n foo\n"
296− describe "Text.Libyaml with all tags on" $ do
297− let enc = testEncodeWith $ Y.setTagRendering Y.renderAllTags Y.defaultFormatOptions
298− it "will output custom sequence tags" $
299− enc taggedSequence `shouldReturn` "!foo []\n"
300− it "will output custom mapping tags" $
301− enc taggedMapping `shouldReturn` "!foo {}\n"
302− it "will output default sequence tags" $
303− enc defaultTaggedSequence `shouldReturn` "!!seq []\n"
304− it "will output default mapping tags" $
305− enc defaultTaggedMapping `shouldReturn` "!!map {}\n"
306− it "handles NoTag on sequences" $
307− enc untaggedSequence `shouldReturn` "[]\n"
308− it "handles NoTag on mappings" $
309− enc untaggedMapping `shouldReturn` "{}\n"
310− it "handles mixed tag usages outputting all mapping and sequence tags" $
311− enc mixedTagSampleA `shouldReturn` "- !foo {}\n"
312− it "in combination of tags, anchors and styles, outputs all the tags" $
313− enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c !baz [&d !!null '']\n"
314− it "outputs plain tags" $
315− enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "!!str foo\n"
316− it "respects PlainNoTag tags" $
317− enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n"
318− describe "Text.Libyaml with uri tags on" $ do
319− let enc = testEncodeWith $ Y.setTagRendering Y.renderUriTags Y.defaultFormatOptions
320− it "will output custom sequence tags" $
321− enc taggedSequence `shouldReturn` "!foo []\n"
322− it "will output custom mapping tags" $
323− enc taggedMapping `shouldReturn` "!foo {}\n"
324− it "will output default sequence tags" $
325− enc defaultTaggedSequence `shouldReturn` "[]\n"
326− it "will output default mapping tags" $
327− enc defaultTaggedMapping `shouldReturn` "{}\n"
328− it "handles NoTag on sequences" $
329− enc untaggedSequence `shouldReturn` "[]\n"
330− it "handles NoTag on mappings" $
331− enc untaggedMapping `shouldReturn` "{}\n"
332− it "handles mixed tag usages outputting all mapping and sequence tags" $
333− enc mixedTagSampleA `shouldReturn` "- !foo {}\n"
334− it "in combination of tags, anchors and styles, outputs all the tags" $
335− enc mixedTagSampleB `shouldReturn` "&a\n&b !<bar> foo: &c !baz [&d '']\n"
336− describe "Text.Libyaml with tags off" $ do
337− let enc = testEncodeWith $ Y.setTagRendering Y.renderNoTags Y.defaultFormatOptions
338− it "outputs plain tags" $
339− enc [Y.EventScalar "foo" Y.StrTag Y.Plain Nothing] `shouldReturn` "foo\n"
340− it "respects PlainNoTag tags" $
341− enc [Y.EventScalar "foo" Y.StrTag Y.PlainNoTag Nothing] `shouldReturn` "foo\n"
342− it "elides tags when double quoted" $
343− enc [Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing] `shouldReturn` "\"foo\"\n"
344− it "elides tags when single quoted" $
345− enc [Y.EventScalar "foo" Y.StrTag Y.SingleQuoted Nothing] `shouldReturn` "'foo'\n"
346− it "elides tags on literal text" $
347− enc [Y.EventScalar "foo" Y.StrTag Y.Literal Nothing] `shouldReturn` "|-\n foo\n"
348− it "elides tags on folded text" $
349− enc [Y.EventScalar "foo" Y.StrTag Y.Folded Nothing] `shouldReturn` ">-\n foo\n"
350− describe "Text.Libyaml with only UriTags set to render " $ do
351− let enc =
352− testEncodeWith $
353− Y.setTagRendering Y.renderUriTags $ Y.defaultFormatOptions
354− it "outputs only UriTags" $
355− enc
356− [ Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing
357− , Y.EventScalar "foo" Y.StrTag Y.DoubleQuoted Nothing
358− , Y.EventScalar "99" Y.IntTag Y.Plain Nothing
359− , Y.EventScalar "99.99" Y.FloatTag Y.Plain Nothing
360− , Y.EventScalar "bar" Y.NoTag Y.Plain Nothing
361− , Y.EventScalar "foo" (Y.UriTag "!foo") Y.DoubleQuoted Nothing
362− , Y.EventScalar "foo" (Y.UriTag "!foo") Y.Plain Nothing
363− , Y.EventSequenceEnd
364− ] `shouldReturn`
365− "[\"foo\", 99, 99.99, bar, !foo \"foo\", !foo foo]\n"
366−
367− prop "Scientific values round-trip" $ \coeff expon -> do
368− let val = D.Number $ S.scientific coeff expon
369− let rendered = D.encode val
370− case D.decodeEither' rendered of
371− Left e -> error $ show (coeff, expon, e)
372− Right val' -> val' `shouldBe` val
373−
374−specialStrings :: [T.Text]
375−specialStrings =
376− [ "fo\"o"
377− , "fo\'o"
378− , "fo\\'o"
379− , "fo: o"
380− , "foo\nbar\nbaz\n"
381− ]
382−
383−counter :: Monad m => (Y.Event -> Bool) -> ConduitM Y.Event o m Int
384−counter pred' =
385− CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
386−
387−caseHelper :: String
388− -> (Y.Event -> Bool)
389− -> Int
390− -> Assertion
391−caseHelper yamlString pred' expRes = do
392− res <- runConduitRes $ Y.decode (B8.pack yamlString) .| counter pred'
393− res @?= expRes
394−
395−caseCountScalarsWithAnchor :: Assertion
396−caseCountScalarsWithAnchor =
397− caseHelper yamlString isScalarA 1
398− where
399− yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
400− isScalarA (Y.EventScalar _ _ _ (Just _)) = True
401− isScalarA _ = False
402−
403−caseCountSequencesWithAnchor :: Assertion
404−caseCountSequencesWithAnchor =
405− caseHelper yamlString isSequenceStartA 1
406− where
407− yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
408− isSequenceStartA (Y.EventSequenceStart Y.NoTag _ (Just _)) = True
409− isSequenceStartA _ = False
410−
411−caseCountMappingsWithAnchor :: Assertion
412−caseCountMappingsWithAnchor =
413− caseHelper yamlString isMappingA 1
414− where
415− yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
416− isMappingA (Y.EventMappingStart _ _ (Just _)) = True
417− isMappingA _ = False
418−
419−caseCountAliases :: Assertion
420−caseCountAliases =
421− caseHelper yamlString isAlias 1
422− where
423− yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
424− isAlias Y.EventAlias{} = True
425− isAlias _ = False
426−
427−caseCountMappingTags :: Assertion
428−caseCountMappingTags =
429− caseHelper yamlString isCustomTaggedMapping 1
430− where
431− yamlString = "foo: !bar\n k: v\n k2: v2"
432− isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True
433− isCustomTaggedMapping _ = False
434−
435−caseCountEmptyMappingTags :: Assertion
436−caseCountEmptyMappingTags =
437− caseHelper yamlString isCustomTaggedMapping 1
438− where
439− yamlString = "foo: !\n k: v\n k2: v2"
440− isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!") _ _) = True
441− isCustomTaggedMapping _ = False
442−
443−caseCountSequenceTags :: Assertion
444−caseCountSequenceTags =
445− caseHelper yamlString isCustomTaggedSequence 1
446− where
447− yamlString = "foo: !bar [x, y, z]"
448− isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True
449− isCustomTaggedSequence _ = False
450−
451−caseCountEmptySequenceTags :: Assertion
452−caseCountEmptySequenceTags =
453− caseHelper yamlString isCustomTaggedSequence 1
454− where
455− yamlString = "foo: ! [x, y, z]"
456− isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!") _ _) = True
457− isCustomTaggedSequence _ = False
458−
459−caseCountFlowStyleSequences :: Assertion
460−caseCountFlowStyleSequences =
461− caseHelper yamlString isFlowStyleSequence 1
462− where
463− yamlString = "foo: [x, y, z]"
464− isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True
465− isFlowStyleSequence _ = False
466−
467−caseCountBlockStyleSequences :: Assertion
468−caseCountBlockStyleSequences =
469− caseHelper yamlString isBlockStyleSequence 1
470− where
471− yamlString = "foo:\n- x\n- y\n- z\n"
472− isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True
473− isBlockStyleSequence _ = False
474−
475−caseCountFlowStyleMappings :: Assertion
476−caseCountFlowStyleMappings =
477− caseHelper yamlString isFlowStyleMapping 1
478− where
479− yamlString = "foo: { bar: 1, baz: 2 }"
480− isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True
481− isFlowStyleMapping _ = False
482−
483−caseCountBlockStyleMappings :: Assertion
484−caseCountBlockStyleMappings =
485− caseHelper yamlString isBlockStyleMapping 1
486− where
487− yamlString = "foo: bar\nbaz: quux"
488− isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True
489− isBlockStyleMapping _ = False
490−
491−caseCountScalars :: Assertion
492−caseCountScalars = do
493− res <- runConduitRes $ Y.decode yamlBS .| CL.fold adder accum
494− res @?= (7, 1, 2)
495− where
496− yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
497− yamlBS = B8.pack yamlString
498− adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)
499− adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
500− adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)
501− adder a _ = a
502− accum = (0, 0, 0) :: (Int, Int, Int)
503−
504−caseLargestString :: Assertion
505−caseLargestString = do
506− res <- runConduitRes $ Y.decodeFile filePath .| CL.fold adder accum
507− res @?= (length expected, expected)
508− where
509− expected = "this one is just a little bit bigger than the others"
510− filePath = "test/largest-string.yaml"
511− adder (i, s) (Y.EventScalar bs _ _ _) =
512− let s' = B8.unpack bs
513− i' = length s'
514− in if i' > i then (i', s') else (i, s)
515− adder acc _ = acc
516− accum = (0, "no strings found")
517−
518−newtype MyEvent = MyEvent Y.Event deriving Show
519−instance Eq MyEvent where
520− (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
521− s == s' && t == t'
522− MyEvent e1 == MyEvent e2 = e1 == e2
523−
524−caseEncodeDecode :: Assertion
525−caseEncodeDecode = do
526− eList <- runConduitRes $ Y.decode yamlBS .| CL.consume
527− bs <- runConduitRes $ CL.sourceList eList .| Y.encode
528− eList2 <- runConduitRes $ Y.decode bs .| CL.consume
529− map MyEvent eList @=? map MyEvent eList2
530− where
531− yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
532− yamlBS = B8.pack yamlString
533−
534−caseEncodeDecodeEvents :: Assertion
535−caseEncodeDecodeEvents = do
536− let events = Internal.objToEvents D.defaultStringStyle testJSON []
537− result <- Internal.decodeHelper_ . CL.sourceList $ eventStream events
538− let (_, value) = either (error . show) id result
539− value @?= testJSON
540−
541−caseEncodeDecodeFile :: Assertion
542−caseEncodeDecodeFile = withFile "" $ \tmpPath -> do
543− eList <- runConduitRes $ Y.decodeFile filePath .| CL.consume
544− runConduitRes $ CL.sourceList eList .| Y.encodeFile tmpPath
545− eList2 <- runConduitRes $ Y.decodeFile filePath .| CL.consume
546− map MyEvent eList @=? map MyEvent eList2
547− where
548− filePath = "test/largest-string.yaml"
549−
550−caseInterleave :: Assertion
551−caseInterleave = withFile "" $ \tmpPath -> withFile "" $ \tmpPath2 -> do
552− () <- runConduitRes $ Y.decodeFile filePath .| Y.encodeFile tmpPath
553− () <- runConduitRes $ Y.decodeFile tmpPath .| Y.encodeFile tmpPath2
554− f1 <- readFile tmpPath
555− f2 <- readFile tmpPath2
556− f1 @=? f2
557− where
558− filePath = "test/largest-string.yaml"
559−
560−caseDecodeInvalidDocument :: Assertion
561−caseDecodeInvalidDocument = do
562− x <- try $ runConduitRes $ Y.decode yamlBS .| CL.sinkNull
563− case x of
564− Left (_ :: SomeException) -> return ()
565− Right y -> do
566− putStrLn $ "bad return value: " ++ show y
567− assertFailure "expected parsing exception, but got no errors"
568− where
569− yamlString = " - foo\n - baz\nbuz"
570− yamlBS = B8.pack yamlString
571−
572−mkScalar :: String -> D.Value
573−mkScalar = mkStrScalar
574−
575−mkStrScalar :: String -> D.Value
576−mkStrScalar = D.String . T.pack
577−
578−mappingKey :: D.Value-> String -> D.Value
579−mappingKey (D.Object m) k = (fromJust . M.lookup (fromText $ T.pack k) $ m)
580−mappingKey _ _ = error "expected Object"
581−
582−sample :: D.Value
583−sample = array
584− [ D.String "foo"
585− , object
586− [ ("bar1", D.String "bar2")
587− , ("bar3", D.String "")
588− ]
589− , D.String ""
590− , D.Number 1
591− , D.Number 0.1
592− , D.Bool True
593− , D.Null
594− ]
595−
596−sampleBuilder :: B.YamlBuilder
597−sampleBuilder = B.array
598− [ B.string "foo"
599− , B.mapping
600− [ ("bar1", B.string "bar2")
601− , ("bar3", B.string "")
602− ]
603− , B.string ""
604− , B.scientific 1
605− , B.scientific 0.1
606− , B.bool True
607− , B.null
608− ]
609−
610−caseEncodeDecodeData :: Assertion
611−caseEncodeDecodeData = D.encode sample `shouldDecode` sample
612−
613−caseEncodeDecodeDataPretty :: Assertion
614−caseEncodeDecodeDataPretty =
615− Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
616−
617−caseEncodeDecodeDataBuilder :: Assertion
618−caseEncodeDecodeDataBuilder = do
619− let events = B.unYamlBuilder sampleBuilder []
620− bs <- testEncodeWith Y.defaultFormatOptions events
621− bs `shouldDecodeEvents` eventStream events
622−
623−caseEncodeDecodeComplexMappingBuilder :: Assertion
624−caseEncodeDecodeComplexMappingBuilder = do
625− let events = B.unYamlBuilder builder []
626− bs <- testEncodeWith Y.defaultFormatOptions events
627− bs `shouldDecodeEvents` eventStream events
628− where
629− builder :: B.YamlBuilder
630− builder = B.mappingComplex
631− [ ( B.mapping
632− [ ("foo", B.scientific 1)
633− , ("bar", B.scientific 2)
634− ]
635− , B.bool True
636− )
637− ]
638−
639−caseEncodeDecodeFileData :: Assertion
640−caseEncodeDecodeFileData = withFile "" $ \fp -> do
641− D.encodeFile fp sample
642− out <- D.decodeFileThrow fp
643− out @?= sample
644−
645−caseEncodeDecodeNonAsciiFileData :: Assertion
646−caseEncodeDecodeNonAsciiFileData = do
647− let mySample = (object ["foo" .= True])
648− inTempDirectory $ do
649− createDirectory "accenté"
650− D.encodeFile "accenté/bar.yaml" mySample
651− out1 <- D.decodeFileThrow "accenté/bar.yaml"
652− out1 @?= mySample
653−
654− c <- readFile "test/resources/accent/foo.yaml"
655− inTempDirectory $ do
656− createDirectoryIfMissing True "test/resources/unicode/accenté/"
657− writeFile "test/resources/unicode/accenté/foo.yaml" c
658− out2 <- D.decodeFileThrow "test/resources/unicode/accenté/foo.yaml"
659− out2 @?= mySample
660−
661−caseEncodeDecodeStrings :: Assertion
662−caseEncodeDecodeStrings = D.encode sample `shouldDecode` sample
663−
664−caseEncodeDecodeStringsPretty :: Assertion
665−caseEncodeDecodeStringsPretty =
666− Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
667−
668−caseDecodeInvalid :: Assertion
669−caseDecodeInvalid =
670− D.decodeThrow "\tthis is 'not' valid :-)" `shouldBe`
671− (Nothing :: Maybe D.Value)
672−
673−caseSimpleScalarAlias :: Assertion
674−caseSimpleScalarAlias =
675− "- &anch foo\n- baz\n- *anch" `shouldDecode`
676− array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
677−
678−caseSimpleSequenceAlias :: Assertion
679−caseSimpleSequenceAlias =
680− "seq: &anch\n - foo\n - baz\nseq2: *anch" `shouldDecode`
681− object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]
682−
683−caseSimpleMappingAlias :: Assertion
684−caseSimpleMappingAlias =
685− "map: &anch\n key1: foo\n key2: baz\nmap2: *anch" `shouldDecode`
686− object [(packStr "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (packStr "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]
687− where
688− packStr = fromText . T.pack
689−
690−caseMappingAliasBeforeAnchor :: Assertion
691−caseMappingAliasBeforeAnchor =
692− case D.decodeThrow "map: *anch\nmap2: &anch\n key1: foo\n key2: baz" of
693− Nothing -> pure ()
694− Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
695−
696−caseMappingAliasInsideAnchor :: Assertion
697−caseMappingAliasInsideAnchor = do
698− case D.decodeThrow "map: &anch\n key1: foo\n key2: *anch" of
699− Nothing -> pure ()
700− Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
701−
702−caseScalarAliasOverriding :: Assertion
703−caseScalarAliasOverriding =
704− "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch" `shouldDecode`
705− array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]
706−
707−caseAllKeysShouldBeUnique :: Assertion
708−caseAllKeysShouldBeUnique = do
709− res <- D.decodeThrow "foo1: foo\nfoo2: baz\nfoo1: buz"
710− mappingKey res "foo1" `shouldBe` mkScalar "buz"
711−
712−caseSimpleMappingMerge :: Assertion
713−caseSimpleMappingMerge = do
714− res <- D.decodeThrow "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
715− mappingKey res "foo1" `shouldBe` mkScalar "foo"
716− mappingKey res "foo3" `shouldBe` mkScalar "fuz"
717−
718−caseMergeSequence :: Assertion
719−caseMergeSequence = do
720− res <- D.decodeThrow "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 ]"
721− mappingKey res "foo1" @?= (mkScalar "foo")
722− mappingKey res "k1" @?= (D.String "1")
723− mappingKey res "k2" @?= (D.String "2")
724− mappingKey res "k3" @?= (D.String "4")
725−
726−caseDataTypes :: Assertion
727−caseDataTypes =
728− D.encode val `shouldDecode` val
729− where
730− val = object
731− [ ("string", D.String "foo")
732− , ("int", D.Number 5)
733− , ("float", D.Number 4.3)
734− , ("true", D.Bool True)
735− , ("false", D.Bool False)
736− , ("null", D.Null)
737− ]
738−
739−caseEncodeInvalidNumbers :: Assertion
740−caseEncodeInvalidNumbers =
741− D.encode (D.String ".") `shouldBe` ".\n"
742−
743−caseDataTypesPretty :: Assertion
744−caseDataTypesPretty =
745− Pretty.encodePretty Pretty.defConfig val `shouldDecode` val
746− where
747− val = object
748− [ ("string", D.String "foo")
749− , ("int", D.Number 5)
750− , ("float", D.Number 4.3)
751− , ("true", D.Bool True)
752− , ("false", D.Bool False)
753− , ("null", D.Null)
754− ]
755−caseQuotedNumber, caseUnquotedNumber, caseAttribNumber, caseIntegerDecimals :: Assertion
756−caseQuotedNumber = "foo: \"1234\"" `shouldDecode` object [("foo", D.String "1234")]
757−caseUnquotedNumber = "foo: 1234" `shouldDecode` object [("foo", D.Number 1234)]
758−caseAttribNumber = "foo: !!str 1234" `shouldDecode` object [("foo", D.String "1234")]
759−caseIntegerDecimals = "1\n" `shouldDecode` (1 :: Int)
760−
761−obj :: D.Value
762−obj = object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)]
763−
764−caseLowercaseBool, caseUppercaseBool, caseTitlecaseBool :: Assertion
765−caseLowercaseBool = "foo: off\nbar: y\nbaz: true" `shouldDecode` obj
766−caseUppercaseBool = "foo: FALSE\nbar: Y\nbaz: ON" `shouldDecode` obj
767−caseTitlecaseBool = "foo: No\nbar: Yes\nbaz: True" `shouldDecode` obj
768−
769−caseEmptyInput :: Assertion
770−caseEmptyInput = B8.empty `shouldDecode` D.Null
771−
772−caseEmptyInputFile :: Assertion
773−caseEmptyInputFile = do
774− out <- D.decodeFileEither "test/resources/empty.yaml"
775− either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
776−
777−caseCommentOnlyInput :: Assertion
778−caseCommentOnlyInput = "# comment\n" `shouldDecode` D.Null
779−
780−caseCommentOnlyInputFile :: Assertion
781−caseCommentOnlyInputFile = do
782− out <- D.decodeFileEither "test/resources/empty2.yaml"
783− either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
784−
785−checkNull :: T.Text -> Spec
786−checkNull x =
787− it ("null recognized: " ++ show x) $
788− B8.pack ("foo: " ++ T.unpack x) `shouldDecode` object [("foo", D.Null)]
789−
790−caseStripAlias :: Assertion
791−caseStripAlias =
792− src `shouldDecode` object
793− [ "Default" .= object
794− [ "foo" .= (1 :: Int)
795− , "bar" .= (2 :: Int)
796− ]
797− , "Obj" .= object
798− [ "foo" .= (1 :: Int)
799− , "bar" .= (2 :: Int)
800− , "key" .= (3 :: Int)
801− ]
802− ]
803− where
804− src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n"
805−
806−caseIssue49 :: Assertion
807−caseIssue49 =
808− src `shouldDecode` object
809− [ "a" .= object [ "value" .= (1.0 :: Double) ]
810− , "b" .= object [ "value" .= (1.2 :: Double) ]
811− ]
812− where
813− src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2"
814−
815−-- | We cannot guarantee this before aeson started using 'Scientific'.
816−casePreservesScientificPrecision :: Assertion
817−casePreservesScientificPrecision = do
818− "x: 1e-100000" `shouldDecode` object
819− [ "x" .= D.Number (read "1e-100000") ]
820− -- Note that this ought to work also without 'Scientific', given
821− -- that @read (show "9.78159610558926e-5") == 9.78159610558926e-5@.
822− -- However, it didn't work (and still doesn't work with aeson < 0.7)
823− -- for two reasons:
824− --
825− -- - We use 'Data.Text.Read.double', which is not as accurate as it
826− -- can be;
827− -- - Even if we used 'Data.Text.Read.rational' we would not get good
828− -- results, because of <https://github.com/bos/text/issues/34>.
829− "x: 9.78159610558926e-5" `shouldDecode` object
830− [ "x" .= D.Number (read "9.78159610558926e-5") ]
831−
832−caseTruncatesFiles :: Assertion
833−caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do
834− replicateM_ 500 $ B8.hPut h "HELLO WORLD!!!!!\n"
835− hClose h
836− let val = object ["hello" .= ("world" :: String)]
837− D.encodeFile fp val
838− res <- D.decodeFileEither fp
839− either (Left . show) Right res `shouldBe` Right val
840−
841−caseSpecialKeys :: (KeyMap () -> B8.ByteString) -> Assertion
842−caseSpecialKeys encoder = do
843− let keys = T.words "true false NO YES 1.2 1e5 null"
844− bs = encoder $ M.fromList $ map (, ()) $ fmap fromText keys
845− text = decodeUtf8 bs
846− forM_ keys $ \key -> do
847− let quoted = T.concat ["'", key, "'"]
848− unless (quoted `T.isInfixOf` text) $ error $ concat
849− [ "Could not find quoted key: "
850− , T.unpack quoted
851− , "\n\n"
852− , T.unpack text
853− ] :: IO ()
854−
855−taggedSequence :: [Y.Event]
856−taggedSequence =
857− [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
858− , Y.EventSequenceEnd
859− ]
860−
861−taggedMapping :: [Y.Event]
862−taggedMapping =
863− [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
864− , Y.EventMappingEnd
865− ]
866−
867−defaultTaggedSequence :: [Y.Event]
868−defaultTaggedSequence =
869− [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
870−
871−defaultTaggedMapping :: [Y.Event]
872−defaultTaggedMapping =
873− [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd]
874−
875−untaggedSequence :: [Y.Event]
876−untaggedSequence =
877− [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
878−
879−untaggedMapping :: [Y.Event]
880−untaggedMapping =
881− [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd]
882−
883−mixedTagSampleA :: [Y.Event]
884−mixedTagSampleA =
885− [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
886− , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
887− , Y.EventMappingEnd
888− , Y.EventSequenceEnd
889− ]
890−
891−mixedTagSampleB :: [Y.Event]
892−mixedTagSampleB =
893− [ Y.EventMappingStart Y.NoTag Y.BlockMapping (Just "a")
894− , Y.EventScalar "foo" (Y.UriTag "bar") Y.Plain (Just "b")
895− , Y.EventSequenceStart (Y.UriTag "!baz") Y.FlowSequence (Just "c")
896− , Y.EventScalar "" Y.NullTag Y.Plain (Just "d")
897− , Y.EventSequenceEnd
898− , Y.EventMappingEnd
899− ]