@@ -20,6 +20,9 @@ import Foreign.Ptr
2020import Foreign.ForeignPtr
2121import Foreign.Marshal.Alloc
2222
23+import Data.Attempt
24+import Control.Monad.Attempt.Class
25+
2326data ParserStruct
2427type Parser = Ptr ParserStruct
2528parserSize :: Int
@@ -70,13 +73,13 @@ foreign import ccall unsafe "yaml_event_delete"
7073foreign import ccall "print_parser_error"
7174 c_print_parser_error :: Parser -> IO ()
7275
73−-- FIXME more grace error handling
74−parserParseOne :: Parser -> IO Event
76+parserParseOne :: Parser -> IO (Attempt Event)
7577parserParseOne parser = withEventRaw $ \er -> do
7678 res <- c_yaml_parser_parse parser er
77− when (res == 0) $
78− c_print_parser_error parser >> fail "yaml_parser_parse failed"
79− event <- getEvent er
79+ event <-
80+ if res == 0
81+ then c_print_parser_error parser >> return (failureString "yaml_parser_parse failed") -- FIXME get the actual error message
82+ else return `fmap` getEvent er
8083 c_yaml_event_delete er
8184 return event
8285
@@ -139,14 +142,19 @@ getEvent er = do
139142 YamlMappingStartEvent -> return EventMappingStart
140143 YamlMappingEndEvent -> return EventMappingEnd
141144
142−parserParse :: Parser -> IO [Event]
145+parserParse :: Parser -> IO (Attempt [Event])
143146parserParse parser = do
144− event <- parserParseOne parser
145− case event of
146− EventStreamEnd -> return [event]
147− _ -> do
148− rest <- parserParse parser
149− return $! event : rest
147+ event' <- parserParseOne parser
148+ case event' of
149+ Failure e -> return $ Failure e
150+ Success event ->
151+ case event of
152+ EventStreamEnd -> return $ Success [event]
153+ _ -> do
154+ rest <- parserParse parser
155+ case rest of
156+ Failure e -> return $ Failure e
157+ Success rest' -> return $ Success $ event : rest'
150158
151159-- Emitter
152160
@@ -175,20 +183,23 @@ foreign import ccall unsafe "get_buffer_buff"
175183foreign import ccall unsafe "get_buffer_used"
176184 c_get_buffer_used :: Buffer -> IO CULong
177185
178−withBuffer :: (Buffer -> IO ()) -> IO B.ByteString
186+withBuffer :: (Buffer -> IO (Attempt ())) -> IO (Attempt B.ByteString)
179187withBuffer f = do
180188 allocaBytes bufferSize $ \b -> do
181189 c_buffer_init b
182− f b
183− ptr' <- c_get_buffer_buff b
184− len <- c_get_buffer_used b
185− fptr <- newForeignPtr_ $ castPtr ptr'
186− return $! B.fromForeignPtr fptr 0 $ fromIntegral len
190+ aRes <- f b
191+ case aRes of
192+ Failure e -> return $ Failure e
193+ Success () -> do
194+ ptr' <- c_get_buffer_buff b
195+ len <- c_get_buffer_used b
196+ fptr <- newForeignPtr_ $ castPtr ptr'
197+ return $ Success $ B.fromForeignPtr fptr 0 $ fromIntegral len
187198
188199foreign import ccall unsafe "my_emitter_set_output"
189200 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
190201
191−withEmitter :: (Emitter -> IO ()) -> IO B.ByteString
202+withEmitter :: (Emitter -> IO (Attempt ())) -> IO (Attempt B.ByteString)
192203withEmitter f = do
193204 allocaBytes emitterSize $ \e -> do
194205 _res <- c_yaml_emitter_initialize e
@@ -205,14 +216,13 @@ foreign import ccall unsafe "yaml_emitter_emit"
205216foreign import ccall unsafe "print_emitter_error"
206217 c_print_emitter_error :: Emitter -> IO ()
207218
208−-- FIXME more graceful error handling
209−emitEvents :: Emitter -> [Event] -> IO ()
210−emitEvents _ [] = return ()
219+emitEvents :: Emitter -> [Event] -> IO (Attempt ())
220+emitEvents _ [] = return $ Success ()
211221emitEvents emitter (e:rest) = do
212222 res <- toEventRaw e $ c_yaml_emitter_emit emitter
213− when (res == 0) $
214− c_print_emitter_error emitter >> fail "yaml_emitter_emit failed"
215− emitEvents emitter rest
223+ if res == 0
224+ then c_print_emitter_error emitter >> return (failureString "yaml_emitter_emit failed") -- FIXME get the actual error message
225+ else emitEvents emitter rest
216226
217227foreign import ccall unsafe "yaml_stream_start_event_initialize"
218228 c_yaml_stream_start_event_initialize :: EventRaw -> CInt -> IO CInt