on master help sign in
Added fclose call and some exception stuff
f9f6245Michael Snoyman
Text/Libyaml.hs+11−4
@@ -33,7 +33,7 @@ import Foreign.Ptr
33import Foreign.ForeignPtr
33import Foreign.ForeignPtr
34import Foreign.Marshal.Alloc
34import Foreign.Marshal.Alloc
35
35
36−import Control.Exception (throwIO, Exception)
36+import Control.Exception (throwIO, Exception, SomeException)
37import Data.Typeable (Typeable)
37import Data.Typeable (Typeable)
38
38
39data Event =
39data Event =
@@ -103,7 +103,10 @@ data YamlException =
103 , parserContext :: String
103 , parserContext :: String
104 , parserOffset :: Int
104 , parserOffset :: Int
105 }
105 }
106− | YamlEmitterException { emitterProblem :: String }
106+ | YamlEmitterException
107+ { emitterEvent :: Event
108+ , emitterProblem :: String
109+ }
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
116
120
@@ -374,13 +378,16 @@ withEmitterFile fp f = allocaBytes emitterSize $ \e -> do
374 else do
378 else 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'
381+ res' <-
377− if file == nullPtr
382+ if file == nullPtr
378 then return $ Left $ YamlFileNotFound fp
383 then return $ Left $ YamlFileNotFound fp
379 else do
384 else do
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'
389+ c_fclose file
390+ return res'
384
391
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
401 then do
408 then do
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
405
412
406foreign import ccall unsafe "yaml_stream_start_event_initialize"
413foreign import ccall unsafe "yaml_stream_start_event_initialize"
yaml.cabal+1−1
@@ -30,7 +30,7 @@ library
30 build-depends: base >= 4 && < 5,
30 build-depends: base >= 4 && < 5,
31 bytestring >= 0.9.1.4 && < 0.10
31 bytestring >= 0.9.1.4 && < 0.10
32 exposed-modules: Text.Libyaml
32 exposed-modules: Text.Libyaml
33− ghc-options: -Wall
33+ ghc-options: -Wall -auto-all -caf-all
34 c-sources: c/helper.c,
34 c-sources: c/helper.c,
35 c/api.c,
35 c/api.c,
36 c/dumper.c,
36 c/dumper.c,