git.iko.soy/typeable/yaml
on 90dd080 help sign in
typeable/yaml/test/main.hs
289 lines 11 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.Monadic
18import Test.Hspec.HUnit ()
20import qualified Data.Yaml as D
21import Data.Yaml (object, array)
22import Data.Maybe
23import qualified Data.HashMap.Strict as M
24import qualified Data.Text as T
26main :: IO ()
27main = hspecX $ do
28 describe "streaming" $ do
29 it "count scalars with anchor" caseCountScalarsWithAnchor
30 it "count sequences with anchor" caseCountSequencesWithAnchor
31 it "count mappings with anchor" caseCountMappingsWithAnchor
32 it "count aliases" caseCountAliases
33 it "count scalars" caseCountScalars
34 it "largest string" caseLargestString
35 it "encode/decode" caseEncodeDecode
36 it "encode/decode file" caseEncodeDecodeFile
37 it "interleaved encode/decode" caseInterleave
38 it "decode invalid document (without segfault)" caseDecodeInvalidDocument
39 describe "Data.Yaml" $ do
40 it "encode/decode" caseEncodeDecodeData
41 it "encode/decode file" caseEncodeDecodeFileData
42 it "encode/decode strings" caseEncodeDecodeStrings
43 it "decode invalid file" caseDecodeInvalid
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
56counter :: (Y.Event -> Bool) -> C.Sink Y.Event IO Int
57counter pred' =
58 CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
60caseHelper :: String
61 -> (Y.Event -> Bool)
62 -> Int
63 -> Assertion
64caseHelper yamlString pred' expRes = do
65 res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'
66 res @?= expRes
68caseCountScalarsWithAnchor :: Assertion
69caseCountScalarsWithAnchor =
70 caseHelper yamlString isScalarA 1
71 where
72 yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
73 isScalarA (Y.EventScalar _ _ _ (Just _)) = True
74 isScalarA _ = False
76caseCountSequencesWithAnchor :: Assertion
77caseCountSequencesWithAnchor =
78 caseHelper yamlString isSequenceStartA 1
79 where
80 yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
81 isSequenceStartA (Y.EventSequenceStart (Just _)) = True
82 isSequenceStartA _ = False
84caseCountMappingsWithAnchor :: Assertion
85caseCountMappingsWithAnchor =
86 caseHelper yamlString isMappingA 1
87 where
88 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
89 isMappingA (Y.EventMappingStart (Just _)) = True
90 isMappingA _ = False
92caseCountAliases :: Assertion
93caseCountAliases =
94 caseHelper yamlString isAlias 1
95 where
96 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
97 isAlias Y.EventAlias{} = True
98 isAlias _ = False
100caseCountScalars :: Assertion
101caseCountScalars = do
102 res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum
103 res @?= (7, 1, 2)
104 where
105 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
106 yamlBS = B8.pack yamlString
107 adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)
108 adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
109 adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)
110 adder a _ = a
111 accum = (0, 0, 0) :: (Int, Int, Int)
113caseLargestString :: Assertion
114caseLargestString = do
115 res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum
116 res @?= (length expected, expected)
117 where
118 expected = "this one is just a little bit bigger than the others"
119 filePath = "test/largest-string.yaml"
120 adder (i, s) (Y.EventScalar bs _ _ _) =
121 let s' = B8.unpack bs
122 i' = length s'
123 in if i' > i then (i', s') else (i, s)
124 adder acc _ = acc
125 accum = (0, "no strings found")
127newtype MyEvent = MyEvent Y.Event deriving Show
128instance Eq MyEvent where
129 (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
130 s == s' && t == t'
131 MyEvent e1 == MyEvent e2 = e1 == e2
133caseEncodeDecode :: Assertion
134caseEncodeDecode = do
135 eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume
136 bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode
137 eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume
138 map MyEvent eList @=? map MyEvent eList2
139 where
140 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
141 yamlBS = B8.pack yamlString
143removeFile' :: FilePath -> IO ()
144removeFile' fp = do
145 x <- doesFileExist fp
146 when x $ removeFile fp
148caseEncodeDecodeFile :: Assertion
149caseEncodeDecodeFile = do
150 removeFile' tmpPath
151 eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
152 C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath
153 eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
154 map MyEvent eList @=? map MyEvent eList2
155 where
156 filePath = "test/largest-string.yaml"
157 tmpPath = "tmp.yaml"
159caseInterleave :: Assertion
160caseInterleave = do
161 removeFile' tmpPath
162 removeFile' tmpPath2
163 () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath
164 () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2
165 f1 <- readFile tmpPath
166 f2 <- readFile tmpPath2
167 f1 @=? f2
168 where
169 filePath = "test/largest-string.yaml"
170 tmpPath = "tmp.yaml"
171 tmpPath2 = "tmp2.yaml"
173caseDecodeInvalidDocument :: Assertion
174caseDecodeInvalidDocument = do
175 x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull
176 case x of
177 Left (_ :: SomeException) -> return ()
178 Right y -> do
179 putStrLn $ "bad return value: " ++ show y
180 assertFailure "expected parsing exception, but got no errors"
181 where
182 yamlString = " - foo\n - baz\nbuz"
183 yamlBS = B8.pack yamlString
185mkScalar :: String -> D.Value
186mkScalar = mkStrScalar
188mkStrScalar :: String -> D.Value
189mkStrScalar = D.String . T.pack
191mappingKey :: D.Value-> String -> D.Value
192mappingKey (D.Object m) k = (fromJust . M.lookup (T.pack k) $ m)
193mappingKey _ _ = error "expected Object"
195decodeYaml :: String -> Maybe D.Value
196decodeYaml s = D.decode $ B8.pack s
198sample :: D.Value
199sample = array
200 [ D.String "foo"
201 , object
202 [ ("bar1", D.String "bar2")
203 ]
204 ]
206caseEncodeDecodeData :: Assertion
207caseEncodeDecodeData = do
208 let out = D.decode $ D.encode sample
209 out @?= Just sample
211caseEncodeDecodeFileData :: Assertion
212caseEncodeDecodeFileData = do
213 let fp = "tmp.yaml"
214 D.encodeFile fp sample
215 out <- D.decodeFile fp
216 out @?= Just sample
218caseEncodeDecodeStrings :: Assertion
219caseEncodeDecodeStrings = do
220 let out = D.decode $ D.encode sample
221 out @?= Just sample
223caseDecodeInvalid :: Assertion
224caseDecodeInvalid = do
225 let invalid = B8.pack "\tthis is 'not' valid :-)"
226 Nothing @=? (D.decode invalid :: Maybe D.Value)
228caseSimpleScalarAlias :: Assertion
229caseSimpleScalarAlias = do
230 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"
231 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
232 let res = fromJust maybeRes
233 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo")]
235caseSimpleSequenceAlias :: Assertion
236caseSimpleSequenceAlias = do
237 let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"
238 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
239 let res = fromJust maybeRes
240 res @?= object [("seq", array [(mkScalar "foo"), (mkScalar "baz")]), ("seq2", array [(mkScalar "foo"), (mkScalar "baz")])]
242caseSimpleMappingAlias :: Assertion
243caseSimpleMappingAlias = do
244 let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"
245 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
246 let res = fromJust maybeRes
247 res @?= object [(T.pack "map", object [("key1", mkScalar "foo"), ("key2", (mkScalar "baz"))]), (T.pack "map2", object [("key1", (mkScalar "foo")), ("key2", mkScalar "baz")])]
249caseMappingAliasBeforeAnchor :: Assertion
250caseMappingAliasBeforeAnchor = do
251 let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"
252 isNothing res @? "decode should return Nothing due to unknown alias"
254caseMappingAliasInsideAnchor :: Assertion
255caseMappingAliasInsideAnchor = do
256 let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"
257 isNothing res @? "decode should return Nothing due to unknown alias"
259caseScalarAliasOverriding :: Assertion
260caseScalarAliasOverriding = do
261 let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"
262 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
263 let res = fromJust maybeRes
264 res @?= array [(mkScalar "foo"), (mkScalar "baz"), (mkScalar "foo"), (mkScalar "boo"), (mkScalar "buz"), (mkScalar "boo")]
266caseAllKeysShouldBeUnique :: Assertion
267caseAllKeysShouldBeUnique = do
268 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"
269 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
270 let res = fromJust maybeRes
271 mappingKey res "foo1" @?= (mkScalar "buz")
273caseSimpleMappingMerge :: Assertion
274caseSimpleMappingMerge = do
275 let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
276 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
277 let res = fromJust maybeRes
278 mappingKey res "foo1" @?= (mkScalar "foo")
279 mappingKey res "foo3" @?= (mkScalar "fuz")
281caseMergeSequence :: Assertion
282caseMergeSequence = do
283 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 ]"
284 isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
285 let res = fromJust maybeRes
286 mappingKey res "foo1" @?= (mkScalar "foo")
287 mappingKey res "k1" @?= (mkStrScalar "1")
288 mappingKey res "k2" @?= (mkStrScalar "2")
289 mappingKey res "k3" @?= (mkStrScalar "4")