git.iko.soy/typeable/yaml
on master help sign in
Proper encodeFile implementation
344b38aMichael Snoyman
Text/Libyaml.hs+23−7
compare with master
unifiedsplit
@@ -361,6 +361,27 @@ withEmitter f = allocaBytes emitterSize $ \e -> do
361 c_yaml_emitter_delete e
361 c_yaml_emitter_delete e
362 return bs
362 return bs
363
363
364+foreign import ccall unsafe "yaml_emitter_set_output_file"
365+ c_yaml_emitter_set_output_file :: Emitter -> File -> IO ()
366+
367+withEmitterFile :: FilePath
368+ -> (Emitter -> IO (Either YamlException ()))
369+ -> IO (Either YamlException ())
370+withEmitterFile fp f = allocaBytes emitterSize $ \e -> do
371+ res <- c_yaml_emitter_initialize e
372+ if res == 0
373+ then return $ Left YamlOutOfMemory
374+ else do
375+ file <- withCString fp $ \fp' -> withCString "w" $ \w' ->
376+ c_fopen fp' w'
377+ if file == nullPtr
378+ then return $ Left $ YamlFileNotFound fp
379+ else do
380+ c_yaml_emitter_set_output_file e file
381+ res' <- f e
382+ c_yaml_emitter_delete e
383+ return res'
384+
364foreign import ccall unsafe "yaml_emitter_emit"
385foreign import ccall unsafe "yaml_emitter_emit"
365 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
386 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
366
387
@@ -501,13 +522,8 @@ encodeFile :: FilePath
501 -> (a -> Maybe (Event, a))
522 -> (a -> Maybe (Event, a))
502 -> a
523 -> a
503 -> IO (Either YamlException ())
524 -> IO (Either YamlException ())
504−encodeFile filePath unfold src = do
525+encodeFile filePath unfold src =
505− res <- withEmitter $ emitEvents unfold src
526+ withEmitterFile filePath $ emitEvents unfold src
506− case res of
507− Left e -> return $ Left e
508− Right bs -> do
509− Data.ByteString.writeFile filePath bs
510− return $ Right ()
511
527
512decode :: B.ByteString
528decode :: B.ByteString
513 -> (a -> Event -> Either a a)
529 -> (a -> Event -> Either a a)
runtests.hs+1−1
@@ -73,7 +73,7 @@ caseEncodeDecodeFile = do
73 eList' <- toIO $ decodeFile filePath fold id
73 eList' <- toIO $ decodeFile filePath fold id
74 let eList = eList' []
74 let eList = eList' []
75 toIO $ encodeFile tmpPath unfold eList
75 toIO $ encodeFile tmpPath unfold eList
76− eList2' <- toIO $ decodeFile tmpPath fold id
76+ eList2' <- toIO $ decodeFile filePath fold id
77 let eList2 = eList2' []
77 let eList2 = eList2' []
78 map MyEvent eList @=? map MyEvent eList2
78 map MyEvent eList @=? map MyEvent eList2
79 where
79 where