git.iko.soy/typeable/yaml
on master help sign in
Initializing scalar event properly; checking return codes
37e7d39Michael Snoyman
Data/Object/Yaml.hs+1
compare with master
unifiedsplit
@@ -82,6 +82,7 @@ data YamlException =
82 , parserOffset :: Int
82 , parserOffset :: Int
83 }
83 }
84 | YamlEmitterException { emitterProblem :: String }
84 | YamlEmitterException { emitterProblem :: String }
85+ | YamlOutOfMemory
85 | YamlInvalidEventStreamBeginning [Event]
86 | YamlInvalidEventStreamBeginning [Event]
86 | YamlInvalidEventStreamEnd [Event]
87 | YamlInvalidEventStreamEnd [Event]
87 | YamlPrematureEventStreamEnd
88 | YamlPrematureEventStreamEnd
Text/Libyaml.hs+20−14
@@ -27,6 +27,7 @@ import Data.Convertible.Text
27import Control.Applicative
27import Control.Applicative
28
28
29import Data.Object.Yaml hiding (style, value)
29import Data.Object.Yaml hiding (style, value)
30+import Control.Exception (throwIO)
30
31
31data ParserStruct
32data ParserStruct
32type Parser = Ptr ParserStruct
33type Parser = Ptr ParserStruct
@@ -53,8 +54,8 @@ foreign import ccall unsafe "yaml_parser_set_input_string"
53withParser :: B.ByteString -> (Parser -> IO a) -> IO a
54withParser :: B.ByteString -> (Parser -> IO a) -> IO a
54withParser bs f = allocaBytes parserSize $ \p ->
55withParser bs f = allocaBytes parserSize $ \p ->
55 do
56 do
56− _res <- c_yaml_parser_initialize p
57+ res <- c_yaml_parser_initialize p
57− -- FIXME check res
58+ when (res == 0) $ throwIO YamlOutOfMemory
58 let (fptr, offset, len) = B.toForeignPtr bs
59 let (fptr, offset, len) = B.toForeignPtr bs
59 ret <- withForeignPtr fptr $ \ptr ->
60 ret <- withForeignPtr fptr $ \ptr ->
60 do
61 do
@@ -247,8 +248,8 @@ withEmitter :: MonadFailure YamlException m
247 => (Emitter -> IO (YAttempt ()))
248 => (Emitter -> IO (YAttempt ()))
248 -> IO (m B.ByteString)
249 -> IO (m B.ByteString)
249withEmitter f = allocaBytes emitterSize $ \e -> do
250withEmitter f = allocaBytes emitterSize $ \e -> do
250− _res <- c_yaml_emitter_initialize e
251+ res <- c_yaml_emitter_initialize e
251− -- FIXME check res
252+ when (res == 0) $ throwIO YamlOutOfMemory
252 bs <- withBuffer $ \b -> do
253 bs <- withBuffer $ \b -> do
253 c_my_emitter_set_output e b
254 c_my_emitter_set_output e b
254 f e
255 f e
@@ -335,7 +336,7 @@ toEventRaw e f = withEventRaw $ \er -> do
335 c_simple_document_start er
336 c_simple_document_start er
336 EventDocumentEnd ->
337 EventDocumentEnd ->
337 c_yaml_document_end_event_initialize er 1
338 c_yaml_document_end_event_initialize er 1
338− EventScalar bs _tag _style -> do -- FIXME
339+ EventScalar bs thetag style -> do
339 let (fvalue, offset, len) = B.toForeignPtr bs
340 let (fvalue, offset, len) = B.toForeignPtr bs
340 withForeignPtr fvalue $ \value -> do
341 withForeignPtr fvalue $ \value -> do
341 let value' = value `plusPtr` offset
342 let value' = value `plusPtr` offset
@@ -343,15 +344,20 @@ toEventRaw e f = withEventRaw $ \er -> do
343 value'' = if ptrToIntPtr value' == 0
344 value'' = if ptrToIntPtr value' == 0
344 then intPtrToPtr 1 -- c/api.c:827
345 then intPtrToPtr 1 -- c/api.c:827
345 else value'
346 else value'
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
346− c_yaml_scalar_event_initialize
352+ c_yaml_scalar_event_initialize
347− er
353+ er
348− nullPtr -- anchor
354+ nullPtr -- anchor
349− nullPtr -- tag
355+ tagP -- tag
350− value'' -- value
356+ value'' -- value
351− len' -- length
357+ len' -- length
352− 0 -- plain_implicit
358+ 0 -- plain_implicit
353− 1 -- quoted_implicit
359+ qi -- quoted_implicit
354− 0 -- YAML_ANY_SCALAR_STYLE
360+ style' -- style
355 EventSequenceStart ->
361 EventSequenceStart ->
356 c_yaml_sequence_start_event_initialize
362 c_yaml_sequence_start_event_initialize
357 er
363 er
test/tags.hs+1
@@ -5,3 +5,4 @@ main = do
5 bs <- B.readFile "tags.yaml"
5 bs <- B.readFile "tags.yaml"
6 yo <- decodeYaml' bs
6 yo <- decodeYaml' bs
7 print yo
7 print yo
8+ B.putStrLn $ encodeYaml' yo