@@ -66,6 +66,8 @@ import qualified Data.Iteratee.Base.StreamChunk as SC
6666import Control.Applicative
6767import Control.Monad.CatchIO (MonadCatchIO, finally)
6868
69+import qualified Data.ListLike as LL
70+
6971data Event =
7072 EventNone
7173 | EventStreamStart
@@ -379,55 +381,12 @@ foreign import ccall unsafe "get_buffer_buff"
379381foreign import ccall unsafe "get_buffer_used"
380382 c_get_buffer_used :: Buffer -> IO CULong
381383
382−withBufferR :: (With m, MonadFailure YamlException m)
383− => (Buffer -> m ())
384− -> m B.ByteString
385−withBufferR f = allocaBytesR bufferSize $ \b -> do
386− liftIO $ c_buffer_init b
387− f b
388− ptr' <- liftIO $ c_get_buffer_buff b
389− len <- liftIO $ c_get_buffer_used b
390− fptr <- liftIO $ newForeignPtr_ $ castPtr ptr'
391− return $ B.fromForeignPtr fptr 0 $ fromIntegral len
392−
393384foreign import ccall unsafe "my_emitter_set_output"
394385 c_my_emitter_set_output :: Emitter -> Buffer -> IO ()
395386
396−withEmitter :: (With m, MonadFailure YamlException m)
397− => (Emitter -> m ())
398− -> m B.ByteString
399−withEmitter f = allocaBytesR emitterSize $ \e -> do
400− res <- liftIO $ c_yaml_emitter_initialize e
401− when (res == 0) $ failure YamlOutOfMemory
402− bs <- withBufferR $ \b -> do
403− liftIO $ c_my_emitter_set_output e b
404− f e
405− liftIO $ c_yaml_emitter_delete e -- FIXME finally
406− return bs
407−
408387foreign import ccall unsafe "yaml_emitter_set_output_file"
409388 c_yaml_emitter_set_output_file :: Emitter -> File -> IO ()
410389
411−withEmitterFile :: (With m, MonadFailure YamlException m)
412− => FilePath
413− -> (Emitter -> m ())
414− -> m ()
415−withEmitterFile fp f = allocaBytesR emitterSize $ \e -> do
416− res <- liftIO $ c_yaml_emitter_initialize e
417− when (res == 0) $ failure YamlOutOfMemory
418− file <- withCStringR fp $ \fp' -> withCStringR "w" $ \w' ->
419− liftIO (c_fopen fp' w')
420− res' <-
421− if file == nullPtr
422− then failure $ YamlFileNotFound fp
423− else do
424− liftIO $ c_yaml_emitter_set_output_file e file
425− res' <- f e
426− liftIO $ c_yaml_emitter_delete e
427− return res'
428− liftIO $ c_fclose file -- FIXME use finally
429− return res'
430−
431390foreign import ccall unsafe "yaml_emitter_emit"
432391 c_yaml_emitter_emit :: Emitter -> EventRaw -> IO CInt
433392
@@ -625,17 +584,6 @@ newtype ToEventRawException = ToEventRawException CInt
625584 deriving (Show, Typeable)
626585instance Exception ToEventRawException
627586
628−encode :: (With m, MonadFailure YamlException m)
629− => YamlEncoder m ()
630− -> m B.ByteString
631−encode = withEmitter . runReaderT
632−
633−encodeFile :: (With m, MonadFailure YamlException m)
634− => FilePath
635− -> YamlEncoder m ()
636− -> m ()
637−encodeFile filePath = withEmitterFile filePath . runReaderT
638−
639587decode :: SC.StreamChunk c Event
640588 => MonadCatchIO m
641589 => B.ByteString
@@ -709,3 +657,55 @@ parserParseOne' parser = allocaBytesR eventSize $ \er -> do
709657 c_get_parser_error_offset parser
710658 return $ Left $ YamlParserException problem context offset
711659 else liftIO $ Right <$> getEvent er
660+
661+encode :: SC.StreamChunk c Event
662+ => MonadIO m
663+ => IterateeG c Event m B.ByteString
664+encode = joinIM $ liftIO $ do
665+ fp <- mallocForeignPtrBytes emitterSize
666+ res <- withForeignPtr fp c_yaml_emitter_initialize
667+ when (res == 0) $ fail "c_yaml_emitter_initialize failed"
668+ buf <- mallocForeignPtrBytes bufferSize
669+ withForeignPtr buf c_buffer_init
670+ withForeignPtr fp $
671+ \emitter -> withForeignPtr buf $
672+ \b -> c_my_emitter_set_output emitter b
673+ return $ runEmitter (go buf) fp
674+ where
675+ go buf = withForeignPtr buf $ \b -> do
676+ ptr' <- c_get_buffer_buff b
677+ len <- c_get_buffer_used b
678+ fptr <- newForeignPtr_ $ castPtr ptr'
679+ return $ B.fromForeignPtr fptr 0 $ fromIntegral len
680+
681+
682+encodeFile :: SC.StreamChunk c Event
683+ => MonadIO m
684+ => FilePath
685+ -> IterateeG c Event m ()
686+encodeFile filePath = joinIM $ liftIO $ do
687+ fp <- mallocForeignPtrBytes emitterSize
688+ res <- withForeignPtr fp c_yaml_emitter_initialize
689+ when (res == 0) $ fail "c_yaml_emitter_initialize failed"
690+ file <- withCStringR filePath $
691+ \filePath' -> withCStringR "w" $
692+ \w' -> c_fopen filePath' w'
693+ when (file == nullPtr) $ fail $ "could not open file for write: " ++ filePath
694+ withForeignPtr fp $ flip c_yaml_emitter_set_output_file file
695+ return $ runEmitter (c_fclose file) fp
696+
697+runEmitter :: SC.StreamChunk c Event
698+ => MonadIO m
699+ => IO a
700+ -> ForeignPtr EmitterStruct
701+ -> IterateeG c Event m a
702+runEmitter close fp = IterateeG go
703+ where
704+ go (EOF x) = do
705+ liftIO $ withForeignPtr fp c_yaml_emitter_delete
706+ a <- liftIO close
707+ return $ Done a $ EOF x
708+ go (Chunk c) = do
709+ liftIO $ withForeignPtr fp $ \emitter ->
710+ LL.mapM_ (\e -> toEventRaw e $ c_yaml_emitter_emit emitter) c
711+ return $ Cont (runEmitter close fp) Nothing