@@ -1,899 +0,0 @@
2−{-# LANGUAGE PackageImports #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TemplateHaskell #-}
6−{-# LANGUAGE TupleSections #-}
8−module Data.YamlSpec (main, spec) where
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
16−import Test.HUnit hiding (Test, path)
18−import Data.Conduit (runConduitRes, (.|), ConduitM)
19−import qualified Data.Conduit.List as CL
22−import Control.Exception (try, SomeException)
24−import Test.Hspec.QuickCheck
25−import Data.Either.Compat
26−import System.Directory (createDirectory, createDirectoryIfMissing)
27−import Test.Mockery.Directory
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, (.=))
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)
41−import qualified Data.HashMap.Strict as M
43−import qualified Data.Text as T
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)
56−#if MIN_VERSION_aeson(2,0,0)
57−fromText :: T.Text -> K.Key
60−toText :: K.Key -> T.Text
63−fromText :: T.Text -> T.Text
66−toText :: Key -> T.Text
69−type KeyMap a = M.HashMap Text a
73−data TestJSON = TestJSON
76− , anArray :: Vector Text
77− , hash :: HashMap Text Text
78− , extrastring :: Text
79− } deriving (Show, Eq)
81−deriveJSON defaultOptions ''TestJSON
87− , anArray = V.fromList ["a", "b"]
88− , hash = HM.fromList [("key1", "value1"), ("key2", "value2")]
89− , extrastring = "1234-foo"
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
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
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
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
113−testEncodeWith :: Y.FormatOptions -> [Y.Event] -> IO BS.ByteString
114−testEncodeWith opts es = runConduitRes $ CL.sourceList (eventStream es) .| Y.encodeWith opts
116−eventStream :: [Y.Event] -> [Y.Event]
118− [Y.EventStreamStart, Y.EventDocumentStart]
120− ++ [Y.EventDocumentEnd, Y.EventStreamEnd]
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
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"
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
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
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
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)
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]
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"
243− it "aliases in keys #49" caseIssue49
245− it "serialization of +123 #64" $ do
246− D.encode ("+123" :: String) `shouldDecode` ("+123" :: String)
248− it "preserves Scientific precision" casePreservesScientificPrecision
250− it "truncates files" caseTruncatesFiles
252− it "encode quotes special keys #137" $ caseSpecialKeys D.encode
254− it "encodePretty quotes special keys #179" $ caseSpecialKeys (Pretty.encodePretty Pretty.defConfig)
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)
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
353− Y.setTagRendering Y.renderUriTags $ Y.defaultFormatOptions
354− it "outputs only UriTags" $
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
365− "[\"foo\", 99, 99.99, bar, !foo \"foo\", !foo foo]\n"
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
374−specialStrings :: [T.Text]
383−counter :: Monad m => (Y.Event -> Bool) -> ConduitM Y.Event o m Int
385− CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
388− -> (Y.Event -> Bool)
391−caseHelper yamlString pred' expRes = do
392− res <- runConduitRes $ Y.decode (B8.pack yamlString) .| counter pred'
395−caseCountScalarsWithAnchor :: Assertion
396−caseCountScalarsWithAnchor =
397− caseHelper yamlString isScalarA 1
399− yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
400− isScalarA (Y.EventScalar _ _ _ (Just _)) = True
403−caseCountSequencesWithAnchor :: Assertion
404−caseCountSequencesWithAnchor =
405− caseHelper yamlString isSequenceStartA 1
407− yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
408− isSequenceStartA (Y.EventSequenceStart Y.NoTag _ (Just _)) = True
409− isSequenceStartA _ = False
411−caseCountMappingsWithAnchor :: Assertion
412−caseCountMappingsWithAnchor =
413− caseHelper yamlString isMappingA 1
415− yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
416− isMappingA (Y.EventMappingStart _ _ (Just _)) = True
417− isMappingA _ = False
419−caseCountAliases :: Assertion
421− caseHelper yamlString isAlias 1
423− yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
424− isAlias Y.EventAlias{} = True
427−caseCountMappingTags :: Assertion
428−caseCountMappingTags =
429− caseHelper yamlString isCustomTaggedMapping 1
431− yamlString = "foo: !bar\n k: v\n k2: v2"
432− isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!bar") _ _) = True
433− isCustomTaggedMapping _ = False
435−caseCountEmptyMappingTags :: Assertion
436−caseCountEmptyMappingTags =
437− caseHelper yamlString isCustomTaggedMapping 1
439− yamlString = "foo: !\n k: v\n k2: v2"
440− isCustomTaggedMapping (Y.EventMappingStart (Y.UriTag "!") _ _) = True
441− isCustomTaggedMapping _ = False
443−caseCountSequenceTags :: Assertion
444−caseCountSequenceTags =
445− caseHelper yamlString isCustomTaggedSequence 1
447− yamlString = "foo: !bar [x, y, z]"
448− isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!bar") _ _) = True
449− isCustomTaggedSequence _ = False
451−caseCountEmptySequenceTags :: Assertion
452−caseCountEmptySequenceTags =
453− caseHelper yamlString isCustomTaggedSequence 1
455− yamlString = "foo: ! [x, y, z]"
456− isCustomTaggedSequence (Y.EventSequenceStart (Y.UriTag "!") _ _) = True
457− isCustomTaggedSequence _ = False
459−caseCountFlowStyleSequences :: Assertion
460−caseCountFlowStyleSequences =
461− caseHelper yamlString isFlowStyleSequence 1
463− yamlString = "foo: [x, y, z]"
464− isFlowStyleSequence (Y.EventSequenceStart _ Y.FlowSequence _) = True
465− isFlowStyleSequence _ = False
467−caseCountBlockStyleSequences :: Assertion
468−caseCountBlockStyleSequences =
469− caseHelper yamlString isBlockStyleSequence 1
471− yamlString = "foo:\n- x\n- y\n- z\n"
472− isBlockStyleSequence (Y.EventSequenceStart _ Y.BlockSequence _) = True
473− isBlockStyleSequence _ = False
475−caseCountFlowStyleMappings :: Assertion
476−caseCountFlowStyleMappings =
477− caseHelper yamlString isFlowStyleMapping 1
479− yamlString = "foo: { bar: 1, baz: 2 }"
480− isFlowStyleMapping (Y.EventMappingStart _ Y.FlowMapping _) = True
481− isFlowStyleMapping _ = False
483−caseCountBlockStyleMappings :: Assertion
484−caseCountBlockStyleMappings =
485− caseHelper yamlString isBlockStyleMapping 1
487− yamlString = "foo: bar\nbaz: quux"
488− isBlockStyleMapping (Y.EventMappingStart _ Y.BlockMapping _) = True
489− isBlockStyleMapping _ = False
491−caseCountScalars :: Assertion
492−caseCountScalars = do
493− res <- runConduitRes $ Y.decode yamlBS .| CL.fold adder accum
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)
502− accum = (0, 0, 0) :: (Int, Int, Int)
504−caseLargestString :: Assertion
505−caseLargestString = do
506− res <- runConduitRes $ Y.decodeFile filePath .| CL.fold adder accum
507− res @?= (length expected, expected)
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
514− in if i' > i then (i', s') else (i, s)
516− accum = (0, "no strings found")
518−newtype MyEvent = MyEvent Y.Event deriving Show
519−instance Eq MyEvent where
520− (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
522− MyEvent e1 == MyEvent e2 = e1 == e2
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
531− yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
532− yamlBS = B8.pack yamlString
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
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
548− filePath = "test/largest-string.yaml"
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
558− filePath = "test/largest-string.yaml"
560−caseDecodeInvalidDocument :: Assertion
561−caseDecodeInvalidDocument = do
562− x <- try $ runConduitRes $ Y.decode yamlBS .| CL.sinkNull
564− Left (_ :: SomeException) -> return ()
566− putStrLn $ "bad return value: " ++ show y
567− assertFailure "expected parsing exception, but got no errors"
569− yamlString = " - foo\n - baz\nbuz"
570− yamlBS = B8.pack yamlString
572−mkScalar :: String -> D.Value
573−mkScalar = mkStrScalar
575−mkStrScalar :: String -> D.Value
576−mkStrScalar = D.String . T.pack
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"
586− [ ("bar1", D.String "bar2")
587− , ("bar3", D.String "")
596−sampleBuilder :: B.YamlBuilder
597−sampleBuilder = B.array
600− [ ("bar1", B.string "bar2")
601− , ("bar3", B.string "")
610−caseEncodeDecodeData :: Assertion
611−caseEncodeDecodeData = D.encode sample `shouldDecode` sample
613−caseEncodeDecodeDataPretty :: Assertion
614−caseEncodeDecodeDataPretty =
615− Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
617−caseEncodeDecodeDataBuilder :: Assertion
618−caseEncodeDecodeDataBuilder = do
619− let events = B.unYamlBuilder sampleBuilder []
620− bs <- testEncodeWith Y.defaultFormatOptions events
621− bs `shouldDecodeEvents` eventStream events
623−caseEncodeDecodeComplexMappingBuilder :: Assertion
624−caseEncodeDecodeComplexMappingBuilder = do
625− let events = B.unYamlBuilder builder []
626− bs <- testEncodeWith Y.defaultFormatOptions events
627− bs `shouldDecodeEvents` eventStream events
629− builder :: B.YamlBuilder
630− builder = B.mappingComplex
632− [ ("foo", B.scientific 1)
633− , ("bar", B.scientific 2)
639−caseEncodeDecodeFileData :: Assertion
640−caseEncodeDecodeFileData = withFile "" $ \fp -> do
641− D.encodeFile fp sample
642− out <- D.decodeFileThrow fp
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"
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"
661−caseEncodeDecodeStrings :: Assertion
662−caseEncodeDecodeStrings = D.encode sample `shouldDecode` sample
664−caseEncodeDecodeStringsPretty :: Assertion
665−caseEncodeDecodeStringsPretty =
666− Pretty.encodePretty Pretty.defConfig sample `shouldDecode` sample
668−caseDecodeInvalid :: Assertion
670− D.decodeThrow "\tthis is 'not' valid :-)" `shouldBe`
671− (Nothing :: Maybe D.Value)
673−caseSimpleScalarAlias :: Assertion
674−caseSimpleScalarAlias =
675− "- &anch foo\n- baz\n- *anch" `shouldDecode`
676− array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
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")])]
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")])]
688− packStr = fromText . T.pack
690−caseMappingAliasBeforeAnchor :: Assertion
691−caseMappingAliasBeforeAnchor =
692− case D.decodeThrow "map: *anch\nmap2: &anch\n key1: foo\n key2: baz" of
694− Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
696−caseMappingAliasInsideAnchor :: Assertion
697−caseMappingAliasInsideAnchor = do
698− case D.decodeThrow "map: &anch\n key1: foo\n key2: *anch" of
700− Just (_ :: D.Value) -> error "decode should return Nothing due to unknown alias"
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")]
707−caseAllKeysShouldBeUnique :: Assertion
708−caseAllKeysShouldBeUnique = do
709− res <- D.decodeThrow "foo1: foo\nfoo2: baz\nfoo1: buz"
710− mappingKey res "foo1" `shouldBe` mkScalar "buz"
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"
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")
726−caseDataTypes :: Assertion
728− D.encode val `shouldDecode` val
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)
739−caseEncodeInvalidNumbers :: Assertion
740−caseEncodeInvalidNumbers =
741− D.encode (D.String ".") `shouldBe` ".\n"
743−caseDataTypesPretty :: Assertion
744−caseDataTypesPretty =
745− Pretty.encodePretty Pretty.defConfig val `shouldDecode` val
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)
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)
762−obj = object [("foo", D.Bool False), ("bar", D.Bool True), ("baz", D.Bool True)]
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
769−caseEmptyInput :: Assertion
770−caseEmptyInput = B8.empty `shouldDecode` D.Null
772−caseEmptyInputFile :: Assertion
773−caseEmptyInputFile = do
774− out <- D.decodeFileEither "test/resources/empty.yaml"
775− either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
777−caseCommentOnlyInput :: Assertion
778−caseCommentOnlyInput = "# comment\n" `shouldDecode` D.Null
780−caseCommentOnlyInputFile :: Assertion
781−caseCommentOnlyInputFile = do
782− out <- D.decodeFileEither "test/resources/empty2.yaml"
783− either (Left . D.prettyPrintParseException) Right out @?= Right D.Null
785−checkNull :: T.Text -> Spec
787− it ("null recognized: " ++ show x) $
788− B8.pack ("foo: " ++ T.unpack x) `shouldDecode` object [("foo", D.Null)]
790−caseStripAlias :: Assertion
792− src `shouldDecode` object
793− [ "Default" .= object
794− [ "foo" .= (1 :: Int)
795− , "bar" .= (2 :: Int)
798− [ "foo" .= (1 :: Int)
799− , "bar" .= (2 :: Int)
800− , "key" .= (3 :: Int)
804− src = "Default: &def\n foo: 1\n bar: 2\nObj:\n <<: *def\n key: 3\n"
806−caseIssue49 :: Assertion
808− src `shouldDecode` object
809− [ "a" .= object [ "value" .= (1.0 :: Double) ]
810− , "b" .= object [ "value" .= (1.2 :: Double) ]
813− src = "---\na:\n &id5 value: 1.0\nb:\n *id5: 1.2"
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)
825− -- - We use 'Data.Text.Read.double', which is not as accurate as it
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") ]
832−caseTruncatesFiles :: Assertion
833−caseTruncatesFiles = withSystemTempFile "truncate.yaml" $ \fp h -> do
834− replicateM_ 500 $ B8.hPut h "HELLO WORLD!!!!!\n"
836− let val = object ["hello" .= ("world" :: String)]
838− res <- D.decodeFileEither fp
839− either (Left . show) Right res `shouldBe` Right val
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: "
855−taggedSequence :: [Y.Event]
857− [ Y.EventSequenceStart (Y.UriTag "!foo") Y.FlowSequence Nothing
858− , Y.EventSequenceEnd
861−taggedMapping :: [Y.Event]
863− [ Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
867−defaultTaggedSequence :: [Y.Event]
868−defaultTaggedSequence =
869− [Y.EventSequenceStart Y.SeqTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
871−defaultTaggedMapping :: [Y.Event]
872−defaultTaggedMapping =
873− [Y.EventMappingStart Y.MapTag Y.FlowMapping Nothing, Y.EventMappingEnd]
875−untaggedSequence :: [Y.Event]
877− [Y.EventSequenceStart Y.NoTag Y.FlowSequence Nothing, Y.EventSequenceEnd]
879−untaggedMapping :: [Y.Event]
881− [Y.EventMappingStart Y.NoTag Y.FlowMapping Nothing, Y.EventMappingEnd]
883−mixedTagSampleA :: [Y.Event]
885− [ Y.EventSequenceStart Y.NoTag Y.BlockSequence Nothing
886− , Y.EventMappingStart (Y.UriTag "!foo") Y.FlowMapping Nothing
888− , Y.EventSequenceEnd
891−mixedTagSampleB :: [Y.Event]
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