git.iko.soy/typeable/yaml
on master help sign in
Pulled in data-object-yaml code
commite15919b689b4fd58a3669520d983f0922d7635f0 authorMichael Snoyman <michael@snoyman.com> dateWed 28 Dec 2011, 13:39 (15 years ago) parent689a4a4
3 files changed+573−25
compare with master
unifiedsplit
Data/Yaml.hs+391 test/main.hs+174−25 yaml.cabal+8
Data/Yaml.hsnew file+391
@@ -0,0 +1,391 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE CPP #-}
4+{-# LANGUAGE DeriveDataTypeable #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE PackageImports #-}
7+{-# LANGUAGE PatternGuards #-}
8+{-|
9+As a bit of background, this package is built on a few other packages I wrote.
10+yaml is a low-level wrapper around the C libyaml library, with an enumerator
11+interface. data-object is a package defining a data type:
12+
13+@
14+ data Object k v = Scalar v
15+ | Sequence [Object k v]
16+ | Mapping [(k, Object k v)]
17+@
18+
19+In other words, it can represent JSON data fully, and YAML data almost fully.
20+In particular, it doesn't handle cyclical aliases, which I hope doesn't really
21+occur too much in real life.
22+
23+Another package to deal with is failure: it basically replaces using an Either
24+for error-handling into a typeclass. It has instances for Maybe, IO and lists
25+ by default.
26+
27+The last package is convertible-text, which is a fork of John Goerzen's
28+convertible package. The difference is it supports both conversions that are
29+guaranteed to succeed (Int -> String) and ones which may fail (String -> Int),
30+and also supports various textual datatypes (String, lazy\/strict ByteString,
31+lazy\/string Text).
32+
33+/YamlScalar and YamlObject/
34+
35+We have a @type YamlObject = Object YamlScalar YamlScalar@, where a YamlScalar
36+is just a ByteString value with a tag and a style. A \"style\" is how the data
37+was represented in the underlying YAML file: single quoted, double quoted, etc.
38+
39+Then there is an IsYamlScalar typeclass, which provides fromYamlScalar and
40+toYamlScalar conversion functions. There are instances for all the
41+\"text-like\" datatypes: String, ByteString and Text. The built-in instances
42+all assume a UTF-8 data encoding. And around this we have toYamlObject and
43+fromYamlObject functions, which do exactly what they sound like.
44+
45+/Encoding and decoding/
46+
47+There are two encoding files: encode and encodeFile. You can guess the
48+different: the former produces a ByteString (strict) and the latter writes to a
49+file. They both take an Object, whose keys and values must be an instance of
50+IsYamlScalar. So, for example:
51+
52+@
53+ encodeFile "myfile.yaml" $ Mapping
54+ [ ("Michael", Mapping
55+ [ ("age", Scalar "26")
56+ , ("color", Scalar "blue")
57+ ])
58+ , ("Eliezer", Mapping
59+ [ ("age", Scalar "2")
60+ , ("color", Scalar "green")
61+ ])
62+ ]
63+@
64+
65+decoding is only slightly more complicated, since the decoding can fail. In
66+particular, the return type is an IO wrapped around a Failure. For example, you
67+could use:
68+
69+@
70+ maybeObject <- decodeFile "myfile.yaml"
71+ case maybeObject of
72+ Nothing -> putStrLn "Error parsing YAML file."
73+ Just object -> putStrLn "Successfully parsed."
74+@
75+
76+If you just want to throw any parse errors as IO exception, you can use join:
77+
78+@
79+ import Control.Monad (join)
80+ object <- join $ decodeFile "myfile.yaml"
81+@
82+
83+This takes advantage of the IO instance of Failure.
84+
85+/Parsing an Object/
86+
87+In order to pull the data out of an Object, you can use the helper functions
88+from Data.Object. For example:
89+
90+@
91+ import Data.Object
92+ import Data.Object.Yaml
93+ import Control.Monad
94+
95+ main = do
96+ object <- join $ decodeFile "myfile.yaml"
97+ people <- fromMapping object
98+ michael <- lookupMapping "Michael" people
99+ age <- lookupScalar "age" michael
100+ putStrLn $ "Michael is " ++ age ++ " years old."
101+@
102+
103+lookupScalar and friends implement Maybe, so you can test for optional
104+attributes by switching on Nothing/Just a:
105+
106+@
107+ name <- lookupScalar "middleName" michael :: Maybe String
108+@
109+
110+
111+/And that's it/
112+
113+There's really not more to know about this library. Enjoy!
114+-}
115+module Data.Yaml
116+ ( -- * Definition of 'YamlObject'
117+ YamlScalar (..)
118+ , YamlObject
119+ -- * Automatic scalar conversions
120+ , IsYamlScalar (..)
121+ , toYamlObject
122+ , fromYamlObject
123+ -- * Encoding/decoding
124+ , encode
125+ , encodeFile
126+ , decode
127+ , decodeFile
128+ -- * Exceptions
129+ , ParseException (..)
130+ ) where
131+
132+import qualified Text.Libyaml as Y
133+import Text.Libyaml hiding (encode, decode, encodeFile, decodeFile)
134+import Data.Object
135+import Data.ByteString (ByteString)
136+import qualified Data.Map as Map
137+import System.IO.Unsafe (unsafePerformIO)
138+import Control.Failure (Failure (failure))
139+
140+import qualified Data.Text
141+import qualified Data.Text.Lazy
142+import qualified Data.ByteString
143+import qualified Data.ByteString.Lazy
144+
145+import Data.Convertible.Text (cs)
146+import Data.Data
147+
148+import Control.Monad.Trans.Class
149+import Control.Monad.IO.Class
150+import Control.Monad.Trans.State
151+import Control.Monad
152+import qualified Data.Conduit as C
153+import qualified Data.Conduit.List as CL
154+import Prelude hiding (catch)
155+import Control.Exception (throwIO, Exception, fromException, try)
156+import Data.String (IsString (fromString))
157+
158+-- | Equality depends on 'value' and 'tag', not 'style'.
159+data YamlScalar = YamlScalar
160+ { value :: ByteString
161+ , tag :: Tag
162+ , style :: Style
163+ }
164+ deriving (Show, Read, Data, Typeable)
165+instance Eq YamlScalar where
166+ (YamlScalar v t _) == (YamlScalar v' t' _) = v == v' && t == t'
167+instance IsString YamlScalar where
168+ fromString = toYamlScalar
169+
170+type YamlObject = Object YamlScalar YamlScalar
171+
172+class (Eq a) => IsYamlScalar a where
173+ fromYamlScalar :: YamlScalar -> a
174+ toYamlScalar :: a -> YamlScalar
175+instance IsYamlScalar YamlScalar where
176+ fromYamlScalar = id
177+ toYamlScalar = id
178+instance IsYamlScalar Data.Text.Text where
179+ fromYamlScalar = cs . value
180+ toYamlScalar t = YamlScalar (cs t) NoTag Any
181+instance IsYamlScalar Data.Text.Lazy.Text where
182+ fromYamlScalar = cs . value
183+ toYamlScalar t = YamlScalar (cs t) NoTag Any
184+instance IsYamlScalar [Char] where
185+ fromYamlScalar = cs . value
186+ toYamlScalar s = YamlScalar (cs s) NoTag Any
187+instance IsYamlScalar Data.ByteString.ByteString where
188+ fromYamlScalar = value
189+ toYamlScalar b = YamlScalar b NoTag Any
190+instance IsYamlScalar Data.ByteString.Lazy.ByteString where
191+ fromYamlScalar = cs . value
192+ toYamlScalar b = YamlScalar (cs b) NoTag Any
193+
194+-- | Merge assoc-lists by keys.
195+-- First list overrides second:
196+-- [(k1, x), (k2, y)] `mergeAssocLists` [(k3, z)] == [(k1, x), (k2, y), (k3, z)]
197+-- [(k1, x), (k2, y)] `mergeAssocLists` [(k2, z)] == [(k1, x), (k2, y)]
198+mergeAssocLists :: (Eq k) => [(k, v)] -> [(k, v)] -> [(k, v)]
199+mergeAssocLists a [] = a
200+mergeAssocLists [] b = b
201+mergeAssocLists a ((bk, bv):bs) =
202+ case lookup bk a of
203+ Nothing -> (bk, bv) : mergeAssocLists a bs
204+ Just av -> (bk, av) : mergeAssocLists (filter (\(x, _) -> x /= bk) a) bs
205+
206+toYamlObject :: IsYamlScalar k
207+ => IsYamlScalar v
208+ => Object k v
209+ -> YamlObject
210+toYamlObject = mapKeysValues toYamlScalar toYamlScalar
211+
212+fromYamlObject :: IsYamlScalar k
213+ => IsYamlScalar v
214+ => YamlObject
215+ -> Object k v
216+fromYamlObject = mapKeysValues fromYamlScalar fromYamlScalar
217+
218+encode :: (IsYamlScalar k, IsYamlScalar v) => Object k v -> ByteString
219+encode obj = unsafePerformIO $
220+ C.runResourceT $ CL.sourceList (objToEvents $ toYamlObject obj)
221+ C.$$ Y.encode
222+
223+encodeFile :: (IsYamlScalar k, IsYamlScalar v)
224+ => FilePath
225+ -> Object k v
226+ -> IO ()
227+encodeFile fp obj = C.runResourceT
228+ $ CL.sourceList (objToEvents $ toYamlObject obj)
229+ C.$$ Y.encodeFile fp
230+
231+objToEvents :: YamlObject -> [Y.Event]
232+objToEvents o = (:) EventStreamStart
233+ . (:) EventDocumentStart
234+ $ objToEvents' o
235+ [ EventDocumentEnd
236+ , EventStreamEnd
237+ ]
238+
239+scalarToEvent :: YamlScalar -> Event
240+scalarToEvent (YamlScalar v t s) = EventScalar v t s Nothing
241+
242+objToEvents' :: YamlObject -> [Y.Event] -> [Y.Event]
243+objToEvents' (Scalar s) rest = scalarToEvent s : rest
244+objToEvents' (Sequence list) rest =
245+ EventSequenceStart Nothing
246+ : foldr ($) (EventSequenceEnd : rest) (map objToEvents' list)
247+objToEvents' (Mapping pairs) rest =
248+ EventMappingStart Nothing
249+ : foldr ($) (EventMappingEnd : rest) (map pairToEvents pairs)
250+
251+pairToEvents :: (YamlScalar, YamlObject) -> [Y.Event] -> [Y.Event]
252+pairToEvents (k, v) rest =
253+ scalarToEvent k
254+ : objToEvents' v rest
255+
256+-- Parsing
257+
258+data ParseException = NonScalarKey
259+ | UnknownAlias { _anchorName :: Y.AnchorName }
260+ | UnexpectedEvent { _received :: Maybe Event
261+ , _expected :: Maybe Event
262+ }
263+ | InvalidYaml (Maybe String)
264+ deriving (Show, Typeable)
265+instance Exception ParseException
266+
267+newtype PErrorT m a = PErrorT { runPErrorT :: m (Either ParseException a) }
268+instance Monad m => Monad (PErrorT m) where
269+ return = PErrorT . return . Right
270+ (PErrorT m) >>= f = PErrorT $ do
271+ e <- m
272+ case e of
273+ Left e' -> return $ Left e'
274+ Right a -> runPErrorT $ f a
275+instance MonadTrans PErrorT where
276+ lift = PErrorT . liftM Right
277+instance MonadIO m => MonadIO (PErrorT m) where
278+ liftIO = lift . liftIO
279+
280+type Parser = StateT (Map.Map String YamlObject) IO
281+
282+requireEvent :: Event -> C.Sink Event Parser ()
283+requireEvent e = do
284+ f <- CL.head
285+ if f == Just e
286+ then return ()
287+ else liftIO $ throwIO $ UnexpectedEvent f $ Just e
288+
289+parse :: C.Sink Event Parser YamlObject
290+parse = do
291+ requireEvent EventStreamStart
292+ requireEvent EventDocumentStart
293+ res <- parseO
294+ requireEvent EventDocumentEnd
295+ requireEvent EventStreamEnd
296+ return res
297+
298+parseScalar :: ByteString -> Tag -> Style -> Anchor
299+ -> C.Sink Event Parser YamlScalar
300+parseScalar v t s a = do
301+ let res = YamlScalar v t s
302+ case a of
303+ Nothing -> return res
304+ Just an -> do
305+ lift $ modify (Map.insert an $ Scalar res)
306+ return res
307+
308+parseO :: C.Sink Event Parser YamlObject
309+parseO = do
310+ me <- CL.head
311+ case me of
312+ Just (EventScalar v t s a) -> Scalar `liftM` parseScalar v t s a
313+ Just (EventSequenceStart a) -> parseS a id
314+ Just (EventMappingStart a) -> parseM a id
315+ Just (EventAlias an) -> do
316+ m <- lift get
317+ case Map.lookup an m of
318+ Nothing -> liftIO $ throwIO $ UnknownAlias an
319+ Just v -> return v
320+ _ -> liftIO $ throwIO $ UnexpectedEvent me Nothing
321+
322+parseS :: Y.Anchor
323+ -> ([YamlObject] -> [YamlObject])
324+ -> C.Sink Event Parser YamlObject
325+parseS a front = do
326+ me <- CL.peek
327+ case me of
328+ Just EventSequenceEnd -> do
329+ CL.drop 1
330+ let res = Sequence $ front []
331+ case a of
332+ Nothing -> return res
333+ Just an -> do
334+ lift $ modify $ Map.insert an res
335+ return res
336+ _ -> do
337+ o <- parseO
338+ parseS a $ front . (:) o
339+
340+parseM :: Y.Anchor
341+ -> ([(YamlScalar, YamlObject)] -> [(YamlScalar, YamlObject)])
342+ -> C.Sink Event Parser YamlObject
343+parseM a front = do
344+ me <- CL.peek
345+ case me of
346+ Just EventMappingEnd -> do
347+ CL.drop 1
348+ let res = Mapping $ front []
349+ case a of
350+ Nothing -> return res
351+ Just an -> do
352+ lift $ modify $ Map.insert an res
353+ return res
354+ _ -> do
355+ me' <- CL.head
356+ s <- case me' of
357+ Just (EventScalar v t s a') -> parseScalar v t s a'
358+ _ -> liftIO $ throwIO $ UnexpectedEvent me' Nothing
359+ o <- parseO
360+ let al = mergeAssocLists [(s, o)] $ front []
361+ al' = if fromYamlScalar s == "<<"
362+ then case o of
363+ Scalar _ -> al
364+ Mapping l -> mergeAssocLists al l
365+ Sequence l -> mergeAssocLists al $ foldl merge' [] l
366+ else al
367+ parseM a (`mergeAssocLists` al')
368+ where merge' :: (Eq k) => [(k, Object k v)] -> Object k v -> [(k, Object k v)]
369+ merge' al (Mapping om) = mergeAssocLists al om
370+ merge' al _ = al
371+
372+decode :: (Failure ParseException m, IsYamlScalar k, IsYamlScalar v)
373+ => ByteString
374+ -> m (Object k v)
375+decode bs = unsafePerformIO $ decodeHelper (Y.decode bs)
376+
377+decodeFile :: (Failure ParseException m, IsYamlScalar k, IsYamlScalar v)
378+ => FilePath
379+ -> IO (m (Object k v))
380+decodeFile fp = decodeHelper (Y.decodeFile fp)
381+
382+decodeHelper :: (Failure ParseException m, IsYamlScalar k, IsYamlScalar v)
383+ => C.Source Parser Y.Event
384+ -> IO (m (Object k v))
385+decodeHelper src = do
386+ x <- try $ flip evalStateT Map.empty $ C.runResourceT $ src C.$$ parse
387+ case x of
388+ Left e
389+ | Just pe <- fromException e -> return $ failure (pe :: ParseException)
390+ | otherwise -> return $ failure $ InvalidYaml $ Just $ show e
391+ Right y -> return $ return $ fromYamlObject y
test/main.hs+174−25
@@ -2,7 +2,7 @@
22{-# LANGUAGE PackageImports #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−import Text.Libyaml
5+import qualified Text.Libyaml as Y
66import qualified Data.ByteString.Char8 as B8
77
88import Test.HUnit hiding (Test, path)
@@ -16,6 +16,11 @@ import Control.Exception (try, SomeException)
1616import Test.Hspec.Monadic
1717import Test.Hspec.HUnit ()
1818
19+import Data.Object
20+import qualified Data.Yaml as D
21+import Data.Maybe
22+import Data.Convertible.Text (cs)
23+
1924main :: IO ()
2025main = hspecX $ do
2126 describe "streaming" $ do
@@ -29,17 +34,34 @@ main = hspecX $ do
2934 it "encode/decode file" caseEncodeDecodeFile
3035 it "interleaved encode/decode" caseInterleave
3136 it "decode invalid document (without segfault)" caseDecodeInvalidDocument
37+ describe "Data.Yaml" $ do
38+ it "encode/decode" caseEncodeDecodeData
39+ it "encode/decode file" caseEncodeDecodeFileData
40+ it "encode/decode strings" caseEncodeDecodeStrings
41+ it "decode invalid file" caseDecodeInvalid
42+ it "encode/decode in order" caseInOrder
43+ describe "Data.Yaml aliases" $ do
44+ it "simple scalar alias" caseSimpleScalarAlias
45+ it "simple sequence alias" caseSimpleSequenceAlias
46+ it "simple mapping alias" caseSimpleMappingAlias
47+ it "mapping alias before anchor" caseMappingAliasBeforeAnchor
48+ it "mapping alias inside anchor" caseMappingAliasInsideAnchor
49+ it "scalar alias overriding" caseScalarAliasOverriding
50+ describe "Data.Yaml merge keys" $ do
51+ it "test uniqueness of keys" caseAllKeysShouldBeUnique
52+ it "test mapping merge" caseSimpleMappingMerge
53+ it "test sequence of mappings merging" caseMergeSequence
3254
33−counter :: (Event -> Bool) -> C.Sink Event IO Int
55+counter :: (Y.Event -> Bool) -> C.Sink Y.Event IO Int
3456counter pred' =
3557 CL.fold (\cnt e -> (if pred' e then 1 else 0) + cnt) 0
3658
3759caseHelper :: String
38− -> (Event -> Bool)
60+ -> (Y.Event -> Bool)
3961 -> Int
4062 -> Assertion
4163caseHelper yamlString pred' expRes = do
42− res <- C.runResourceT $ decode (B8.pack yamlString) C.$$ counter pred'
64+ res <- C.runResourceT $ Y.decode (B8.pack yamlString) C.$$ counter pred'
4365 res @?= expRes
4466
4567caseCountScalarsWithAnchor :: Assertion
@@ -47,7 +69,7 @@ caseCountScalarsWithAnchor =
4769 caseHelper yamlString isScalarA 1
4870 where
4971 yamlString = "foo:\n - &anchor bin1\n - bin2\n - bin3"
50− isScalarA (EventScalar _ _ _ (Just _)) = True
72+ isScalarA (Y.EventScalar _ _ _ (Just _)) = True
5173 isScalarA _ = False
5274
5375caseCountSequencesWithAnchor :: Assertion
@@ -55,7 +77,7 @@ caseCountSequencesWithAnchor =
5577 caseHelper yamlString isSequenceStartA 1
5678 where
5779 yamlString = "foo: &anchor\n - bin1\n - bin2\n - bin3"
58− isSequenceStartA (EventSequenceStart (Just _)) = True
80+ isSequenceStartA (Y.EventSequenceStart (Just _)) = True
5981 isSequenceStartA _ = False
6082
6183caseCountMappingsWithAnchor :: Assertion
@@ -63,7 +85,7 @@ caseCountMappingsWithAnchor =
6385 caseHelper yamlString isMappingA 1
6486 where
6587 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3"
66− isMappingA (EventMappingStart (Just _)) = True
88+ isMappingA (Y.EventMappingStart (Just _)) = True
6789 isMappingA _ = False
6890
6991caseCountAliases :: Assertion
@@ -71,47 +93,47 @@ caseCountAliases =
7193 caseHelper yamlString isAlias 1
7294 where
7395 yamlString = "foo: &anchor\n key1: bin1\n key2: bin2\n key3: bin3\nboo: *anchor"
74− isAlias EventAlias{} = True
96+ isAlias Y.EventAlias{} = True
7597 isAlias _ = False
7698
7799caseCountScalars :: Assertion
78100caseCountScalars = do
79− res <- C.runResourceT $ decode yamlBS C.$$ CL.fold adder accum
101+ res <- C.runResourceT $ Y.decode yamlBS C.$$ CL.fold adder accum
80102 res @?= (7, 1, 2)
81103 where
82104 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
83105 yamlBS = B8.pack yamlString
84− adder (s, l, m) (EventScalar{}) = (s + 1, l, m)
85− adder (s, l, m) (EventSequenceStart{}) = (s, l + 1, m)
86− adder (s, l, m) (EventMappingStart{}) = (s, l, m + 1)
106+ adder (s, l, m) (Y.EventScalar{}) = (s + 1, l, m)
107+ adder (s, l, m) (Y.EventSequenceStart{}) = (s, l + 1, m)
108+ adder (s, l, m) (Y.EventMappingStart{}) = (s, l, m + 1)
87109 adder a _ = a
88110 accum = (0, 0, 0) :: (Int, Int, Int)
89111
90112caseLargestString :: Assertion
91113caseLargestString = do
92− res <- C.runResourceT $ decodeFile filePath C.$$ CL.fold adder accum
114+ res <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.fold adder accum
93115 res @?= (length expected, expected)
94116 where
95117 expected = "this one is just a little bit bigger than the others"
96118 filePath = "test/largest-string.yaml"
97− adder (i, s) (EventScalar bs _ _ _) =
119+ adder (i, s) (Y.EventScalar bs _ _ _) =
98120 let s' = B8.unpack bs
99121 i' = length s'
100122 in if i' > i then (i', s') else (i, s)
101123 adder acc _ = acc
102124 accum = (0, "no strings found")
103125
104−newtype MyEvent = MyEvent Event deriving Show
126+newtype MyEvent = MyEvent Y.Event deriving Show
105127instance Eq MyEvent where
106− (MyEvent (EventScalar s t _ _)) == (MyEvent (EventScalar s' t' _ _)) =
128+ (MyEvent (Y.EventScalar s t _ _)) == (MyEvent (Y.EventScalar s' t' _ _)) =
107129 s == s' && t == t'
108130 MyEvent e1 == MyEvent e2 = e1 == e2
109131
110132caseEncodeDecode :: Assertion
111133caseEncodeDecode = do
112− eList <- C.runResourceT $ decode yamlBS C.$$ CL.consume
113− bs <- C.runResourceT $ CL.sourceList eList C.$$ encode
114− eList2 <- C.runResourceT $ decode bs C.$$ CL.consume
134+ eList <- C.runResourceT $ Y.decode yamlBS C.$$ CL.consume
135+ bs <- C.runResourceT $ CL.sourceList eList C.$$ Y.encode
136+ eList2 <- C.runResourceT $ Y.decode bs C.$$ CL.consume
115137 map MyEvent eList @=? map MyEvent eList2
116138 where
117139 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
@@ -125,9 +147,9 @@ removeFile' fp = do
125147caseEncodeDecodeFile :: Assertion
126148caseEncodeDecodeFile = do
127149 removeFile' tmpPath
128− eList <- C.runResourceT $ decodeFile filePath C.$$ CL.consume
129− C.runResourceT $ CL.sourceList eList C.$$ encodeFile tmpPath
130− eList2 <- C.runResourceT $ decodeFile filePath C.$$ CL.consume
150+ eList <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
151+ C.runResourceT $ CL.sourceList eList C.$$ Y.encodeFile tmpPath
152+ eList2 <- C.runResourceT $ Y.decodeFile filePath C.$$ CL.consume
131153 map MyEvent eList @=? map MyEvent eList2
132154 where
133155 filePath = "test/largest-string.yaml"
@@ -137,8 +159,8 @@ caseInterleave :: Assertion
137159caseInterleave = do
138160 removeFile' tmpPath
139161 removeFile' tmpPath2
140− () <- C.runResourceT $ decodeFile filePath C.$$ encodeFile tmpPath
141− () <- C.runResourceT $ decodeFile tmpPath C.$$ encodeFile tmpPath2
162+ () <- C.runResourceT $ Y.decodeFile filePath C.$$ Y.encodeFile tmpPath
163+ () <- C.runResourceT $ Y.decodeFile tmpPath C.$$ Y.encodeFile tmpPath2
142164 f1 <- readFile tmpPath
143165 f2 <- readFile tmpPath2
144166 f1 @=? f2
@@ -149,7 +171,7 @@ caseInterleave = do
149171
150172caseDecodeInvalidDocument :: Assertion
151173caseDecodeInvalidDocument = do
152− x <- try $ C.runResourceT $ decode yamlBS C.$$ CL.sinkNull
174+ x <- try $ C.runResourceT $ Y.decode yamlBS C.$$ CL.sinkNull
153175 case x of
154176 Left (_ :: SomeException) -> return ()
155177 Right y -> do
@@ -158,3 +180,130 @@ caseDecodeInvalidDocument = do
158180 where
159181 yamlString = " - foo\n - baz\nbuz"
160182 yamlBS = B8.pack yamlString
183+
184+mkFoldedScalar :: String -> D.YamlScalar
185+mkFoldedScalar s = D.YamlScalar (cs s) Y.StrTag Y.Folded
186+
187+mkScalar :: String -> D.YamlScalar
188+mkScalar s = D.YamlScalar (cs s) Y.NoTag Y.Plain
189+
190+mkStrScalar :: String -> D.YamlScalar
191+mkStrScalar s = D.YamlScalar (cs s) Y.StrTag Y.Plain
192+
193+mappingKey :: D.YamlObject -> String -> D.YamlObject
194+mappingKey (Mapping m) k = (fromJust . lookup (mkScalar k) $ m)
195+mappingKey _ _ = error "expected Mapping"
196+
197+decodeYaml :: String -> Maybe D.YamlObject
198+decodeYaml s = D.decode $ B8.pack s
199+
200+sample :: D.YamlObject
201+sample = Sequence
202+ [ Scalar $ mkFoldedScalar "foo"
203+ , Mapping
204+ [ (mkFoldedScalar "bar1", Scalar $ mkFoldedScalar "bar2")
205+ ]
206+ ]
207+
208+sampleStr :: Object String String
209+sampleStr = mapKeysValues D.fromYamlScalar D.fromYamlScalar sample
210+
211+caseEncodeDecodeData :: Assertion
212+caseEncodeDecodeData = do
213+ out <- D.decode $ D.encode sample
214+ out @?= sample
215+
216+caseEncodeDecodeFileData :: Assertion
217+caseEncodeDecodeFileData = do
218+ let fp = "tmp.yaml"
219+ D.encodeFile fp sample
220+ out <- join $ D.decodeFile fp
221+ out @?= sample
222+
223+caseEncodeDecodeStrings :: Assertion
224+caseEncodeDecodeStrings = do
225+ out <- D.decode $ D.encode $ D.toYamlObject sampleStr
226+ D.fromYamlObject out @?= sampleStr
227+
228+caseDecodeInvalid :: Assertion
229+caseDecodeInvalid = do
230+ let invalid = B8.pack "\tthis is 'not' valid :-)"
231+ Nothing @=? (D.decode invalid :: Maybe D.YamlObject)
232+
233+caseSimpleScalarAlias :: Assertion
234+caseSimpleScalarAlias = do
235+ let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch"
236+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
237+ let res = fromJust maybeRes
238+ res @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (mkScalar "foo")]
239+
240+caseSimpleSequenceAlias :: Assertion
241+caseSimpleSequenceAlias = do
242+ let maybeRes = decodeYaml "seq: &anch\n - foo\n - baz\nseq2: *anch"
243+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
244+ let res = fromJust maybeRes
245+ res @?= Mapping [(mkScalar "seq", Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz")]), (mkScalar "seq2", Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz")])]
246+
247+caseSimpleMappingAlias :: Assertion
248+caseSimpleMappingAlias = do
249+ let maybeRes = decodeYaml "map: &anch\n key1: foo\n key2: baz\nmap2: *anch"
250+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
251+ let res = fromJust maybeRes
252+ res @?= Mapping [(mkScalar "map", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (mkScalar "baz"))]), (mkScalar "map2", Mapping [(mkScalar "key1", Scalar (mkScalar "foo")), (mkScalar "key2", Scalar (mkScalar "baz"))])]
253+
254+caseMappingAliasBeforeAnchor :: Assertion
255+caseMappingAliasBeforeAnchor = do
256+ let res = decodeYaml "map: *anch\nmap2: &anch\n key1: foo\n key2: baz"
257+ isNothing res @? "decode should return Nothing due to unknown alias"
258+
259+caseMappingAliasInsideAnchor :: Assertion
260+caseMappingAliasInsideAnchor = do
261+ let res = decodeYaml "map: &anch\n key1: foo\n key2: *anch"
262+ isNothing res @? "decode should return Nothing due to unknown alias"
263+
264+caseScalarAliasOverriding :: Assertion
265+caseScalarAliasOverriding = do
266+ let maybeRes = decodeYaml "- &anch foo\n- baz\n- *anch\n- &anch boo\n- buz\n- *anch"
267+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
268+ let res = fromJust maybeRes
269+ res @?= Sequence [Scalar (mkScalar "foo"), Scalar (mkScalar "baz"), Scalar (mkScalar "foo"), Scalar (mkScalar "boo"), Scalar (mkScalar "buz"), Scalar (mkScalar "boo")]
270+
271+caseAllKeysShouldBeUnique :: Assertion
272+caseAllKeysShouldBeUnique = do
273+ let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\nfoo1: buz"
274+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
275+ let res = fromJust maybeRes
276+ mappingKey res "foo1" @?= Scalar (mkScalar "buz")
277+
278+caseSimpleMappingMerge :: Assertion
279+caseSimpleMappingMerge = do
280+ let maybeRes = decodeYaml "foo1: foo\nfoo2: baz\n<<:\n foo1: buz\n foo3: fuz"
281+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
282+ let res = fromJust maybeRes
283+ mappingKey res "foo1" @?= Scalar (mkScalar "foo")
284+ mappingKey res "foo3" @?= Scalar (mkScalar "fuz")
285+
286+caseMergeSequence :: Assertion
287+caseMergeSequence = do
288+ 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 ]"
289+ isJust maybeRes @? "decoder should return Just YamlObject but returned Nothing"
290+ let res = fromJust maybeRes
291+ mappingKey res "foo1" @?= Scalar (mkScalar "foo")
292+ mappingKey res "k1" @?= Scalar (mkStrScalar "1")
293+ mappingKey res "k2" @?= Scalar (mkStrScalar "2")
294+ mappingKey res "k3" @?= Scalar (mkStrScalar "4")
295+
296+inOrderData :: String
297+inOrderData = "'Fatal': 'Unknown variable \"bar\"'\n'Date': '2001-11-23 15:03:17 -5'\n'User': 'ed'\n'Stack':\n- 'line': '23'\n 'file': 'TopClass.py'\n 'code': 'x = MoreObject(\"345\\n\")\n\n'\n- 'line': '58'\n 'file': 'MoreClass.py'\n 'code': 'foo = bar'\n"
298+
299+inOrderData2 :: String
300+inOrderData2 =
301+ "'a': '1'\n'b': '2'\n'd': '4'\n'c': '3'\n"
302+ ++ "'g': '1'\n'n': '2'\n'q': '4'\n'f': '3'\n"
303+ ++ "'z': '1'\n'y': '2'\n'x': '4'\n'w': '3'\n"
304+
305+caseInOrder :: Assertion
306+caseInOrder = do
307+ Just (Mapping ((x, _):_)) <- return $ decodeYaml inOrderData
308+ x @?= mkScalar "Fatal"
309+ fmap (B8.unpack . D.encode) (decodeYaml inOrderData2) @?= Just inOrderData2
yaml.cabal+8
@@ -29,7 +29,13 @@ library
2929 , transformers >= 0.1 && < 0.3
3030 , bytestring >= 0.9.1.4 && < 0.10
3131 , conduit >= 0.0 && < 0.1
32+ , convertible-text
33+ , text
34+ , failure
35+ , containers
36+ , data-object
3237 exposed-modules: Text.Libyaml
38+ Data.Yaml
3339 ghc-options: -Wall
3440 c-sources: c/helper.c
3541 include-dirs: c
@@ -59,6 +65,8 @@ test-suite test
5965 , bytestring >= 0.9.1.4 && < 0.10
6066 , conduit
6167 , yaml
68+ , data-object
69+ , convertible-text
6270 ghc-options: -Wall
6371 c-sources: c/helper.c
6472 include-dirs: c