yaml 0.7.0.4 → 0.8.0
raw patch · 3 files changed
+40/−44 lines, 3 filesdep ~conduit
Dependency ranges changed: conduit
Files
- Text/Libyaml.hs +38/−37
- test/main.hs +0/−5
- yaml.cabal +2/−2
Text/Libyaml.hs view
@@ -44,7 +44,7 @@ import Control.Exception (throwIO, Exception, finally) import Control.Applicative import Control.Monad.Trans.Resource-import qualified Data.Conduit as C+import Data.Conduit hiding (Source, Sink, Conduit) import Control.Exception (mask_) data Event =@@ -452,10 +452,9 @@ deriving (Show, Typeable) instance Exception ToEventRawException -decode :: C.MonadResource m => B.ByteString -> C.Source m Event-decode bs | B8.null bs = return ()+decode :: MonadResource m => B.ByteString -> GSource m Event decode bs =- C.sourceIO alloc cleanup (runParser . fst)+ bracketP alloc cleanup (runParser . fst) where alloc = mask_ $ do ptr <- mallocBytes parserSize@@ -476,9 +475,9 @@ c_yaml_parser_delete ptr free ptr -decodeFile :: C.MonadResource m => FilePath -> C.Source m Event+decodeFile :: MonadResource m => FilePath -> GSource m Event decodeFile file =- C.sourceIO alloc cleanup (runParser . fst)+ bracketP alloc cleanup (runParser . fst) where alloc = mask_ $ do ptr <- mallocBytes parserSize@@ -507,13 +506,13 @@ c_yaml_parser_delete ptr free ptr -runParser :: C.MonadResource m => Parser -> m (C.SourceIOResult Event)-runParser parser = liftIO $ do- e <- parserParseOne' parser+runParser :: MonadResource m => Parser -> GSource m Event+runParser parser = do+ e <- liftIO $ parserParseOne' parser case e of- Left err -> throwIO $ YamlException err- Right Nothing -> return $ C.IOClosed- Right (Just ev) -> return $ C.IOOpen ev+ Left err -> liftIO $ throwIO $ YamlException err+ Right Nothing -> return ()+ Right (Just ev) -> yield ev >> runParser parser parserParseOne' :: Parser -> IO (Either String (Maybe Event))@@ -536,7 +535,7 @@ ] else Right <$> getEvent er -encode :: C.MonadResource m => C.Sink Event m ByteString+encode :: MonadResource m => GSink Event m ByteString encode = runEmitter alloc close where@@ -545,37 +544,34 @@ withForeignPtr fbuf c_buffer_init withForeignPtr fbuf $ c_my_emitter_set_output emitter return fbuf- close fbuf = withForeignPtr fbuf $ \b -> do+ close _ fbuf = withForeignPtr fbuf $ \b -> do ptr' <- c_get_buffer_buff b len <- c_get_buffer_used b fptr <- newForeignPtr_ $ castPtr ptr' return $ B.fromForeignPtr fptr 0 $ fromIntegral len -encodeFile :: C.MonadResource m+encodeFile :: MonadResource m => FilePath- -> C.Sink Event m ()+ -> GInfSink Event m encodeFile filePath =- C.PipeM msink (return ())+ bracketP getFile c_fclose $ \file -> runEmitter (alloc file) (\u _ -> return u) where- msink = do- (_releaseKey, file) <- flip allocate c_fclose $ do- file <- liftIO $ withCString filePath $- \filePath' -> withCString "w" $- \w' -> c_fopen filePath' w'- if (file == nullPtr)- then throwIO $ YamlException $ "could not open file for write: " ++ filePath- else return file- return $ runEmitter (alloc file) (return) -- FIXME close file early- alloc file emitter = do- c_yaml_emitter_set_output_file emitter file- return ()+ getFile = do+ file <- withCString filePath $+ \filePath' -> withCString "w" $+ \w' -> c_fopen filePath' w'+ if (file == nullPtr)+ then throwIO $ YamlException $ "could not open file for write: " ++ filePath+ else return file -runEmitter :: C.MonadResource m+ alloc file emitter = c_yaml_emitter_set_output_file emitter file++runEmitter :: MonadResource m => (Emitter -> IO a) -- ^ alloc- -> (a -> IO b) -- ^ close- -> C.Sink Event m b+ -> (u -> a -> IO b) -- ^ close+ -> Pipe l Event o u m b runEmitter allocI closeI =- C.sinkIO alloc cleanup push close+ bracketP alloc cleanup go where alloc = mask_ $ do emitter <- mallocBytes emitterSize@@ -586,10 +582,15 @@ cleanup (emitter, _) = do c_yaml_emitter_delete emitter free emitter- push (emitter, _) e = do- _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter- return C.IOProcessing- close (_, a) = liftIO $ closeI a++ go (emitter, a) =+ loop+ where+ loop = awaitE >>= either close push+ push e = do+ _ <- liftIO $ toEventRaw e $ c_yaml_emitter_emit emitter+ loop+ close u = liftIO $ closeI u a data YamlException = YamlException String deriving (Show, Typeable)
test/main.hs view
@@ -61,8 +61,6 @@ it "parses when all lowercase" caseLowercaseBool it "parses when all uppercase" caseUppercaseBool it "parses when titlecase" caseTitlecaseBool- describe "empty input" $ do- it "doesn't crash" caseEmptyInput counter :: Monad m => (Y.Event -> Bool) -> C.Sink Y.Event m Int counter pred' =@@ -324,6 +322,3 @@ caseLowercaseBool = D.decode "foo: off\nbar: y\nbaz: true" @?= obj caseUppercaseBool = D.decode "foo: FALSE\nbar: Y\nbaz: ON" @?= obj caseTitlecaseBool = D.decode "foo: No\nbar: Yes\nbaz: True" @?= obj--caseEmptyInput :: Assertion-caseEmptyInput = D.decode B8.empty @?= (Nothing :: Maybe D.Value)
yaml.cabal view
@@ -1,5 +1,5 @@ name: yaml-version: 0.7.0.4+version: 0.8.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>,Kirill Simonov @@ -30,7 +30,7 @@ build-depends: base >= 4 && < 5 , transformers >= 0.1 && < 0.4 , bytestring >= 0.9.1.4 && < 0.10- , conduit >= 0.4 && < 0.5+ , conduit >= 0.5 && < 0.6 , resourcet >= 0.3 && < 0.4 , aeson >= 0.5 , containers