1{-# LANGUAGE QuasiQuotes #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Data.Yaml.IncludeSpec (main, spec) where
4
5import           Test.Hspec
6import           Data.List (isPrefixOf)
7import qualified Data.ByteString.Lazy as LB
8import           Data.Aeson
9import           Data.Aeson.Internal (JSONPathElement(..))
10import           Data.Yaml (ParseException(InvalidYaml))
11import           Data.Yaml.Include
12import           Data.Yaml.Internal
13import           Text.Libyaml (YamlException(YamlException))
14import           Test.Mockery.Directory
15import           Text.RawString.QQ
16import           Data.Yaml.TH (yamlQQ)
17
18main :: IO ()
19main = hspec spec
20
21asInt :: Int -> Int
22asInt = id
23
24spec :: Spec
25spec = do
26  describe "decodeFile" $ do
27    it "supports includes" $ do
28      decodeFile "test/resources/foo.yaml" `shouldReturn` Just (object
29          [ "foo" .= asInt 23
30          , "bar" .= object
31              [ "one" .= asInt 1
32              , "two" .= asInt 2
33              ]
34          , "baz" .= asInt 42
35          ])
36
37    it "supports recursive includes" $ do
38      decodeFile "test/resources/baz.yaml" `shouldReturn` Just (object
39        [ "foo" .= object
40          [ "foo" .= asInt 23
41          , "bar" .= object
42            [ "one" .= asInt 1
43            , "two" .= asInt 2
44            ]
45          , "baz" .= asInt 42
46          ]
47        ])
48
49    it "aborts on cyclic includes" $ do
50      (decodeFile "test/resources/loop/foo.yaml" :: IO (Maybe Value)) `shouldThrow` anyException
51
52    context "when file does not exist" $ do
53      it "throws Left (InvalidYaml (Just (YamlException \"Yaml file not found: ...\")))" $ do
54        (decodeFile "./does_not_exist.yaml" :: IO (Maybe Value)) `shouldThrow` isYamlFileNotFoundException
55
56    context "with a 1K stack size limit" $ around_ inTempDirectory $ do
57      context "with a large list" $ do
58        it "succeeds" $ do
59          let
60            xs :: [Value]
61            xs = replicate 5000 (Number 23)
62          LB.writeFile "foo.yaml" (encode xs)
63          decodeFile "foo.yaml" `shouldReturn` Just xs
64
65  describe "decodeFileEither" $ do
66    context "when file does not exist" $ do
67      it "returns Left (InvalidYaml (Just (YamlException \"Yaml file not found: ...\")))" $ do
68        (decodeFileEither "./does_not_exist.yaml" :: IO (Either ParseException Value)) >>=
69          (`shouldSatisfy` either isYamlFileNotFoundException (const False))
70
71  describe "decodeFileWithWarnings" $ around_ inTempDirectory $ do
72    it "warns on duplicate keys" $ do
73      writeFile "foo.yaml" [r|
74        foo: 23
75        foo: bar
76        |]
77      Right result <- decodeFileWithWarnings "foo.yaml"
78      result `shouldBe` ([DuplicateKey [Key "foo"]], [yamlQQ|
79        foo: bar
80        |])
81
82    it "warns on nested duplicate keys" $ do
83      writeFile "foo.yaml" [r|
84        foo:
85          - 42
86          - bar: 23
87            bar: baz
88        |]
89      Right result <- decodeFileWithWarnings "foo.yaml"
90      result `shouldBe` ([DuplicateKey [Key "foo", Index 1, Key "bar"]], [yamlQQ|
91        foo:
92          - 42
93          - bar: baz
94        |])
95
96    context "when overriding a merged key" $ do
97      it "does not warn" $ do
98        writeFile "foo.yaml" [r|
99          foo-1: &my-ref
100            bar: 23
101          foo-2:
102            <<: *my-ref
103            bar: 42
104          |]
105        Right result <- decodeFileWithWarnings "foo.yaml"
106        result `shouldBe` ([], [yamlQQ|
107          foo-1:
108            bar: 23
109          foo-2:
110            bar: 42
111          |])
112
113      context "when overriding twice" $ do
114        it "warns" $ do
115          writeFile "foo.yaml" [r|
116            foo-1: &my-ref
117              bar: 23
118            foo-2:
119              <<: *my-ref
120              bar: 42
121              bar: 65
122            |]
123          Right result <- decodeFileWithWarnings "foo.yaml"
124          result `shouldBe` ([DuplicateKey [Key "foo-2", Key "bar"]], [yamlQQ|
125            foo-1:
126              bar: 23
127            foo-2:
128              bar: 65
129            |])
130
131isYamlFileNotFoundException :: ParseException -> Bool
132isYamlFileNotFoundException (InvalidYaml (Just (YamlException msg)))
133  | "Yaml file not found: " `isPrefixOf` msg = True
134isYamlFileNotFoundException _ = False
135