@@ -121,8 +121,8 @@ eventSize = 104
121121foreign import ccall unsafe "yaml_parser_initialize"
122122 c_yaml_parser_initialize :: Parser -> IO CInt
123123
124−foreign import ccall unsafe "yaml_parser_delete"
125− c_yaml_parser_delete :: Parser -> IO ()
124+foreign import ccall unsafe "&yaml_parser_delete"
125+ c_yaml_parser_delete :: FunPtr (Parser -> IO ())
126126
127127foreign import ccall unsafe "yaml_parser_set_input_string"
128128 c_yaml_parser_set_input_string :: Parser
@@ -147,6 +147,9 @@ foreign import ccall unsafe "fclose"
147147 c_fclose :: File
148148 -> IO ()
149149
150+foreign import ccall unsafe "&fclose_helper"
151+ c_fclose_helper :: FunPtr (File -> Parser -> IO ())
152+
150153withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b
151154withForeignPtr' fp f = do
152155 r <- f $ unsafeForeignPtrToPtr fp
@@ -457,6 +460,7 @@ decode :: MonadCatchIO m => B.ByteString -> Enumerator Event m a
457460decode bs i = do
458461 fp <- liftIO $ mallocForeignPtrBytes parserSize
459462 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize
463+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp
460464 a <-
461465 if (res == 0)
462466 then throwError $ YamlException "Yaml out of memory"
@@ -469,12 +473,12 @@ decode bs i = do
469473 liftIO $ withForeignPtr fp $ \p ->
470474 c_yaml_parser_set_input_string p ptr' len'
471475 runParser fp i
472− liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally
473476 return a
474477
475478decodeFile :: MonadIO m => FilePath -> Enumerator Event m a
476479decodeFile file i = do
477480 fp <- liftIO $ mallocForeignPtrBytes parserSize
481+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp
478482 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize
479483 a <-
480484 if res == 0
@@ -483,6 +487,7 @@ decodeFile file i = do
483487 file' <- liftIO
484488 $ withCString file $ \file' -> withCString "r" $ \r' ->
485489 c_fopen file' r'
490+ liftIO $ addForeignPtrFinalizerEnv c_fclose_helper file' fp
486491 if (file' == nullPtr)
487492 then throwError $ YamlException
488493 $ "Yaml file not found: " ++ file
@@ -490,11 +495,7 @@ decodeFile file i = do
490495 liftIO $ withForeignPtr fp $ \p ->
491496 c_yaml_parser_set_input_file p file'
492497 a <- runParser fp i
493− -- FIXME finally
494− liftIO $ c_fclose file'
495− liftIO $ withForeignPtr fp c_yaml_parser_delete
496498 return a
497− liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally
498499 return a
499500
500501runParser :: MonadIO m