881be91 · typeable/yaml

44import Control.Exception (throwIO, Exception, finally)

45import Control.Applicative

46import Control.Monad.Trans.Resource

47−import Data.Conduit

47+import Data.Conduit hiding (Source, Sink, Conduit)

48import Control.Exception (mask_)

49

50data Event =

452 deriving (Show, Typeable)

453instance Exception ToEventRawException

454

455−decode :: MonadResource m => B.ByteString -> Source m Event

455+decode :: MonadResource m => B.ByteString -> GSource m Event

456decode bs =

457 bracketP alloc cleanup (runParser . fst)

458 where

475 c_yaml_parser_delete ptr

476 free ptr

477

478−decodeFile :: MonadResource m => FilePath -> Source m Event

478+decodeFile :: MonadResource m => FilePath -> GSource m Event

479decodeFile file =

480 bracketP alloc cleanup (runParser . fst)

481 where

535 ]

536 else Right <$> getEvent er

537

538−encode :: MonadResource m => Sink Event m ByteString

538+encode :: MonadResource m => GSink Event m ByteString

539encode =

540 runEmitter alloc close

541 where

544 withForeignPtr fbuf c_buffer_init

545 withForeignPtr fbuf $ c_my_emitter_set_output emitter

546 return fbuf

547− close fbuf = withForeignPtr fbuf $ \b -> do

547+ close _ fbuf = withForeignPtr fbuf $ \b -> do

548 ptr' <- c_get_buffer_buff b

549 len <- c_get_buffer_used b

550 fptr <- newForeignPtr_ $ castPtr ptr'

552

553encodeFile :: MonadResource m

554 => FilePath

555− -> Sink Event m ()

555+ -> GInfSink Event m

556encodeFile filePath =

557− bracketP getFile c_fclose $ \file -> runEmitter (alloc file) return

557+ bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u)

558 where

559 getFile = do

560 file <- withCString filePath $

564 then throwIO $ YamlException $ "could not open file for write: " ++ filePath

565 else return file

566

567− alloc file emitter = do

568− c_yaml_emitter_set_output_file emitter file

567+ alloc file emitter = c_yaml_emitter_set_output_file emitter file

569− return ()

570

568

571runEmitter :: MonadResource m

569runEmitter :: MonadResource m

572 => (Emitter -> IO a) -- ^ alloc

570 => (Emitter -> IO a) -- ^ alloc

573− -> (a -> IO b) -- ^ close

571+ -> (u -> a -> IO b) -- ^ close

574− -> Sink Event m b

572+ -> Pipe l Event o u m b

575runEmitter allocI closeI =

573runEmitter allocI closeI =

576 bracketP alloc cleanup go

574 bracketP alloc cleanup go

577 where

575 where

588 go (emitter, a) =

586 go (emitter, a) =

589 loop

587 loop

590 where

588 where

591− loop = await >>= maybe close push

589+ loop = awaitE >>= either close push

592 push e = do

590 push e = do

593 _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter

591 _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter

594 loop

592 loop

595− close = liftIO $ closeI a

593+ close u = liftIO $ closeI u a

596

594

597data YamlException = YamlException String

595data YamlException = YamlException String

598 deriving (Show, Typeable)

596 deriving (Show, Typeable)