on master help sign in
Initializing scalar event properly; checking return codes
commit37e7d39ce303ee0d5505f8b7392018b20b5a335b authorMichael Snoyman <michael@snoyman.com> dateThu 10 Dec 2009, 21:58 (17 years ago) parent55fee44
3 files changed+22−14
Data/Object/Yaml.hs+1 Text/Libyaml.hs+20−14 test/tags.hs+1
Data/Object/Yaml.hs+1
@@ -82,6 +82,7 @@ data YamlException =
8282 , parserOffset :: Int
8383 }
8484 | YamlEmitterException { emitterProblem :: String }
85+ | YamlOutOfMemory
8586 | YamlInvalidEventStreamBeginning [Event]
8687 | YamlInvalidEventStreamEnd [Event]
8788 | YamlPrematureEventStreamEnd
Text/Libyaml.hs+20−14
@@ -27,6 +27,7 @@ import Data.Convertible.Text
2727import Control.Applicative
2828
2929import Data.Object.Yaml hiding (style, value)
30+import Control.Exception (throwIO)
3031
3132data ParserStruct
3233type Parser = Ptr ParserStruct
@@ -53,8 +54,8 @@ foreign import ccall unsafe "yaml_parser_set_input_string"
5354withParser :: B.ByteString -> (Parser -> IO a) -> IO a
5455withParser bs f = allocaBytes parserSize $ \p ->
5556 do
56− _res <- c_yaml_parser_initialize p
57− -- FIXME check res
57+ res <- c_yaml_parser_initialize p
58+ when (res == 0) $ throwIO YamlOutOfMemory
5859 let (fptr, offset, len) = B.toForeignPtr bs
5960 ret <- withForeignPtr fptr $ \ptr ->
6061 do
@@ -247,8 +248,8 @@ withEmitter :: MonadFailure YamlException m
247248 => (Emitter -> IO (YAttempt ()))
248249 -> IO (m B.ByteString)
249250withEmitter f = allocaBytes emitterSize $ \e -> do
250− _res <- c_yaml_emitter_initialize e
251− -- FIXME check res
251+ res <- c_yaml_emitter_initialize e
252+ when (res == 0) $ throwIO YamlOutOfMemory
252253 bs <- withBuffer $ \b -> do
253254 c_my_emitter_set_output e b
254255 f e
@@ -335,7 +336,7 @@ toEventRaw e f = withEventRaw $ \er -> do
335336 c_simple_document_start er
336337 EventDocumentEnd ->
337338 c_yaml_document_end_event_initialize er 1
338− EventScalar bs _tag _style -> do -- FIXME
339+ EventScalar bs thetag style -> do
339340 let (fvalue, offset, len) = B.toForeignPtr bs
340341 withForeignPtr fvalue $ \value -> do
341342 let value' = value `plusPtr` offset
@@ -343,15 +344,20 @@ toEventRaw e f = withEventRaw $ \er -> do
343344 value'' = if ptrToIntPtr value' == 0
344345 then intPtrToPtr 1 -- c/api.c:827
345346 else value'
346− c_yaml_scalar_event_initialize
347− er
348− nullPtr -- anchor
349− nullPtr -- tag
350− value'' -- value
351− len' -- length
352− 0 -- plain_implicit
353− 1 -- quoted_implicit
354− 0 -- YAML_ANY_SCALAR_STYLE
347+ let thetag' = convertSuccess thetag
348+ withCString thetag' $ \tag' -> do
349+ let style' = toEnum $ fromEnum style
350+ tagP = castPtr tag'
351+ qi = if null thetag' then 1 else 0
352+ c_yaml_scalar_event_initialize
353+ er
354+ nullPtr -- anchor
355+ tagP -- tag
356+ value'' -- value
357+ len' -- length
358+ 0 -- plain_implicit
359+ qi -- quoted_implicit
360+ style' -- style
355361 EventSequenceStart ->
356362 c_yaml_sequence_start_event_initialize
357363 er
test/tags.hs+1
@@ -5,3 +5,4 @@ main = do
55 bs <- B.readFile "tags.yaml"
66 yo <- decodeYaml' bs
77 print yo
8+ B.putStrLn $ encodeYaml' yo