@@ -33,7 +33,7 @@ import Foreign.Ptr
33import Foreign.ForeignPtr
33import Foreign.ForeignPtr
34import Foreign.Marshal.Alloc
34import Foreign.Marshal.Alloc
36−import Control.Exception (throwIO, Exception)
36+import Control.Exception (throwIO, Exception, SomeException)
37import Data.Typeable (Typeable)
37import Data.Typeable (Typeable)
39data Event =
39data Event =
@@ -103,7 +103,10 @@ data YamlException =
103 , parserContext :: String
103 , parserContext :: String
104 , parserOffset :: Int
104 , parserOffset :: Int
106− | YamlEmitterException { emitterProblem :: String }
106+ | YamlEmitterException
107+ { emitterEvent :: Event
108+ , emitterProblem :: String
107 | YamlOutOfMemory
110 | YamlOutOfMemory
108 | YamlInvalidEventStreamBeginning [Event]
111 | YamlInvalidEventStreamBeginning [Event]
109 | YamlInvalidEventStreamEnd [Event]
112 | YamlInvalidEventStreamEnd [Event]
@@ -111,6 +114,7 @@ data YamlException =
111 | YamlNonScalarKey
114 | YamlNonScalarKey
112 | YamlInvalidStartingEvent Event
115 | YamlInvalidStartingEvent Event
113 | YamlFileNotFound FilePath
116 | YamlFileNotFound FilePath
117+ | YamlOtherException SomeException
114 deriving (Show, Typeable)
118 deriving (Show, Typeable)
115instance Exception YamlException
119instance Exception YamlException
@@ -374,13 +378,16 @@ withEmitterFile fp f = allocaBytes emitterSize $ \e -> do
375 file <- withCString fp $ \fp' -> withCString "w" $ \w' ->
379 file <- withCString fp $ \fp' -> withCString "w" $ \w' ->
376 c_fopen fp' w'
380 c_fopen fp' w'
377− if file == nullPtr
382+ if file == nullPtr
378 then return $ Left $ YamlFileNotFound fp
383 then return $ Left $ YamlFileNotFound fp
380 c_yaml_emitter_set_output_file e file
385 c_yaml_emitter_set_output_file e file
381 res' <- f e
386 res' <- f e
382 c_yaml_emitter_delete e
387 c_yaml_emitter_delete e
383 return res'
388 return res'
385foreign import ccall unsafe "yaml_emitter_emit"
392foreign import ccall unsafe "yaml_emitter_emit"
386 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
393 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
@@ -400,7 +407,7 @@ emitEvents unfold src emitter = do
400 if res == 0
407 if res == 0
402 problem <- makeString c_get_emitter_error emitter
409 problem <- makeString c_get_emitter_error emitter
403− return $ Left $ YamlEmitterException problem
410+ return $ Left $ YamlEmitterException e problem
404 else emitEvents unfold src' emitter
411 else emitEvents unfold src' emitter
406foreign import ccall unsafe "yaml_stream_start_event_initialize"
413foreign import ccall unsafe "yaml_stream_start_event_initialize"