git.iko.soy/typeable/yaml
on master help sign in
Better decoding type signature
068664bMichael Snoyman
Text/Libyaml.hs+15−9
compare with master
unifiedsplit
@@ -16,6 +16,8 @@ module Text.Libyaml
16 , emitEvents
16 , emitEvents
17 , withParser
17 , withParser
18 , parserParse
18 , parserParse
19+ -- * Enumerator
20+ , EnumResult (..)
19 -- * Higher level functions
21 -- * Higher level functions
20 , encode
22 , encode
21 , decode
23 , decode
@@ -296,18 +298,19 @@ getEvent er = do
296 YamlMappingStartEvent -> return EventMappingStart
298 YamlMappingStartEvent -> return EventMappingStart
297 YamlMappingEndEvent -> return EventMappingEnd
299 YamlMappingEndEvent -> return EventMappingEnd
298
300
299−parserParse :: (a -> Event -> Either a a)
301+parserParse :: (a -> Event -> IO (EnumResult a b))
300 -> a
302 -> a
301 -> Parser
303 -> Parser
302− -> IO (Either YamlException a)
304+ -> IO (Either YamlException b)
303parserParse fold accum parser = do
305parserParse fold accum parser = do
304 event' <- parserParseOne parser
306 event' <- parserParseOne parser
305 case event' of
307 case event' of
306 Left e -> return $ Left e
308 Left e -> return $ Left e
307 Right event -> do
309 Right event -> do
310+ res <- fold accum event
308− case fold accum event of
311+ case res of
309− Left accum' -> return $ Right accum'
312+ Done accum' -> return $ Right accum'
310− Right accum' -> parserParse fold accum' parser
313+ More accum' -> parserParse fold accum' parser
311
314
312-- Emitter
315-- Emitter
313
316
@@ -520,6 +523,9 @@ newtype ToEventRawException = ToEventRawException CInt
520 deriving (Show, Typeable)
523 deriving (Show, Typeable)
521instance Exception ToEventRawException
524instance Exception ToEventRawException
522
525
526+data EnumResult a b = More a | Done b
527+ deriving (Eq, Show)
528+
523encode :: (a -> Maybe (Event, a))
529encode :: (a -> Maybe (Event, a))
524 -> a
530 -> a
525 -> IO (Either YamlException B.ByteString)
531 -> IO (Either YamlException B.ByteString)
@@ -533,13 +539,13 @@ encodeFile filePath unfold src =
533 withEmitterFile filePath $ emitEvents unfold src
539 withEmitterFile filePath $ emitEvents unfold src
534
540
535decode :: B.ByteString
541decode :: B.ByteString
536− -> (a -> Event -> Either a a)
542+ -> (a -> Event -> IO (EnumResult a b))
537 -> a
543 -> a
538− -> IO (Either YamlException a)
544+ -> IO (Either YamlException b)
539decode bs fold accum = withParser bs $ parserParse fold accum
545decode bs fold accum = withParser bs $ parserParse fold accum
540
546
541decodeFile :: FilePath
547decodeFile :: FilePath
542− -> (a -> Event -> Either a a)
548+ -> (a -> Event -> IO (EnumResult a b))
543 -> a
549 -> a
544− -> IO (Either YamlException a)
550+ -> IO (Either YamlException b)
545decodeFile fp fold accum = withFileParser fp $ parserParse fold accum
551decodeFile fp fold accum = withFileParser fp $ parserParse fold accum
runtests.hs+13−13
@@ -25,11 +25,11 @@ caseCountScalars = do
25 where
25 where
26 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
26 yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"
27 yamlBS = B8.pack yamlString
27 yamlBS = B8.pack yamlString
28− fold (s, l, m) (EventScalar {}) = Right (s + 1, l, m)
28+ fold (s, l, m) (EventScalar {}) = return $ More (s + 1, l, m)
29− fold (s, l, m) EventSequenceStart = Right (s, l + 1, m)
29+ fold (s, l, m) EventSequenceStart = return $ More (s, l + 1, m)
30− fold (s, l, m) EventMappingStart = Right (s, l, m + 1)
30+ fold (s, l, m) EventMappingStart = return $ More (s, l, m + 1)
31− fold res EventNone = Left res
31+ fold res EventNone = return $ Done res
32− fold res _ = Right res
32+ fold res _ = return $ More res
33 accum = (0, 0, 0) :: (Int, Int, Int)
33 accum = (0, 0, 0) :: (Int, Int, Int)
34
34
35caseLargestString :: Assertion
35caseLargestString :: Assertion
@@ -43,10 +43,10 @@ caseLargestString = do
43 let s' = B8.unpack bs
43 let s' = B8.unpack bs
44 i' = length s'
44 i' = length s'
45 in if i' > i
45 in if i' > i
46− then Right (i', s')
46+ then return $ More (i', s')
47− else Right (i, s)
47+ else return $ More (i, s)
48− fold res EventNone = Left res
48+ fold res EventNone = return $ Done res
49− fold res _ = Right res
49+ fold res _ = return $ More res
50 accum = (0, "no strings found")
50 accum = (0, "no strings found")
51
51
52toIO :: Exception l => IO (Either l r) -> IO r
52toIO :: Exception l => IO (Either l r) -> IO r
@@ -63,8 +63,8 @@ caseEncodeDecode = do
63 where
63 where
64 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
64 yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"
65 yamlBS = B8.pack yamlString
65 yamlBS = B8.pack yamlString
66− fold x EventNone = Left x
66+ fold x EventNone = return $ Done x
67− fold x e = Right $ x . (:) e
67+ fold x e = return $ More $ x . (:) e
68 unfold (x:xs) = Just (x, xs)
68 unfold (x:xs) = Just (x, xs)
69 unfold [] = Nothing
69 unfold [] = Nothing
70
70
@@ -79,8 +79,8 @@ caseEncodeDecodeFile = do
79 where
79 where
80 filePath = "test/largest-string.yaml"
80 filePath = "test/largest-string.yaml"
81 tmpPath = "tmp.yaml"
81 tmpPath = "tmp.yaml"
82− fold x EventNone = Left x
82+ fold x EventNone = return $ Done x
83− fold x e = Right $ x . (:) e
83+ fold x e = return $ More $ x . (:) e
84 unfold (x:xs) = Just (x, xs)
84 unfold (x:xs) = Just (x, xs)
85 unfold [] = Nothing
85 unfold [] = Nothing
86
86