6b49eb1 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Using finalizers as necessary

6b49eb1Michael Snoyman16 years ago

Text/Libyaml.hs+8−7

compare with master

unifiedsplit

@@ -121,8 +121,8 @@ eventSize = 104

121foreign import ccall unsafe "yaml_parser_initialize"

122 c_yaml_parser_initialize :: Parser -> IO CInt

123

124−foreign import ccall unsafe "yaml_parser_delete"

124+foreign import ccall unsafe "&yaml_parser_delete"

125− c_yaml_parser_delete :: Parser -> IO ()

125+ c_yaml_parser_delete :: FunPtr (Parser -> IO ())

126

127foreign import ccall unsafe "yaml_parser_set_input_string"

128 c_yaml_parser_set_input_string :: Parser

@@ -147,6 +147,9 @@ foreign import ccall unsafe "fclose"

147 c_fclose :: File

148 -> IO ()

149

150+foreign import ccall unsafe "&fclose_helper"

151+ c_fclose_helper :: FunPtr (File -> Parser -> IO ())

152+

150withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b

153withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b

151withForeignPtr' fp f = do

154withForeignPtr' fp f = do

152 r <- f $ unsafeForeignPtrToPtr fp

155 r <- f $ unsafeForeignPtrToPtr fp

@@ -457,6 +460,7 @@ decode :: MonadCatchIO m => B.ByteString -> Enumerator Event m a

457decode bs i = do

460decode bs i = do

458 fp <- liftIO $ mallocForeignPtrBytes parserSize

461 fp <- liftIO $ mallocForeignPtrBytes parserSize

459 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

462 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

463+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp

460 a <-

464 a <-

461 if (res == 0)

465 if (res == 0)

462 then throwError $ YamlException "Yaml out of memory"

466 then throwError $ YamlException "Yaml out of memory"

@@ -469,12 +473,12 @@ decode bs i = do

469 liftIO $ withForeignPtr fp $ \p ->

473 liftIO $ withForeignPtr fp $ \p ->

470 c_yaml_parser_set_input_string p ptr' len'

474 c_yaml_parser_set_input_string p ptr' len'

471 runParser fp i

475 runParser fp i

472− liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally

473 return a

476 return a

474

477

475decodeFile :: MonadIO m => FilePath -> Enumerator Event m a

478decodeFile :: MonadIO m => FilePath -> Enumerator Event m a

476decodeFile file i = do

479decodeFile file i = do

477 fp <- liftIO $ mallocForeignPtrBytes parserSize

480 fp <- liftIO $ mallocForeignPtrBytes parserSize

481+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp

478 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

482 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

479 a <-

483 a <-

480 if res == 0

484 if res == 0

@@ -483,6 +487,7 @@ decodeFile file i = do

483 file' <- liftIO

487 file' <- liftIO

484 $ withCString file $ \file' -> withCString "r" $ \r' ->

488 $ withCString file $ \file' -> withCString "r" $ \r' ->

485 c_fopen file' r'

489 c_fopen file' r'

490+ liftIO $ addForeignPtrFinalizerEnv c_fclose_helper file' fp

486 if (file' == nullPtr)

491 if (file' == nullPtr)

487 then throwError $ YamlException

492 then throwError $ YamlException

488 $ "Yaml file not found: " ++ file

493 $ "Yaml file not found: " ++ file

@@ -490,11 +495,7 @@ decodeFile file i = do

490 liftIO $ withForeignPtr fp $ \p ->

495 liftIO $ withForeignPtr fp $ \p ->

491 c_yaml_parser_set_input_file p file'

496 c_yaml_parser_set_input_file p file'

492 a <- runParser fp i

497 a <- runParser fp i

493− -- FIXME finally

494− liftIO $ c_fclose file'

495− liftIO $ withForeignPtr fp c_yaml_parser_delete

496 return a

498 return a

497− liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally

498 return a

499 return a

499

500

500runParser :: MonadIO m

501runParser :: MonadIO m

c/helper.c+5

@@ -134,3 +134,8 @@ int yaml_parser_set_input_filename(yaml_parser_t *parser, const char *filename)

134 if (!in) return 0;

135 yaml_parser_set_input_file(parser, in);

136}

137+

138+int fclose_helper(FILE *file, yaml_parser_t *parser)

139+{

140+ return fclose(file);

141+}