yaml 0.3.0 → 0.4.0
raw patch · 4 files changed
+139/−154 lines, 4 filesdep +enumeratordep −ListLikedep −iteratee
Dependencies added: enumerator
Dependencies removed: ListLike, iteratee
Files
- Text/Libyaml.hs +68/−73
- c/helper.c +5/−0
- runtests.hs +50/−63
- yaml.cabal +16/−18
Text/Libyaml.hs view
@@ -21,6 +21,8 @@ , decode , encodeFile , decodeFile+ -- * Exception+ , YamlException (..) ) where import qualified Data.ByteString.Internal as B@@ -35,19 +37,13 @@ import Foreign.Marshal.Alloc import Data.Data -#if MIN_VERSION_transformers(0,2,0)-import "transformers" Control.Monad.IO.Class-#else-import "transformers" Control.Monad.Trans-#endif+import Control.Monad.IO.Class+import Control.Monad.Trans.Class (lift) import Control.Exception (throwIO, Exception)-import Data.Iteratee-import qualified Data.Iteratee.Base.StreamChunk as SC+import Data.Enumerator import Control.Applicative-import Control.Monad.CatchIO (MonadCatchIO, finally)--import qualified Data.ListLike as LL+import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO, finally) data Event = EventStreamStart@@ -125,8 +121,8 @@ foreign import ccall unsafe "yaml_parser_initialize" c_yaml_parser_initialize :: Parser -> IO CInt -foreign import ccall unsafe "yaml_parser_delete"- c_yaml_parser_delete :: Parser -> IO ()+foreign import ccall unsafe "&yaml_parser_delete"+ c_yaml_parser_delete :: FunPtr (Parser -> IO ()) foreign import ccall unsafe "yaml_parser_set_input_string" c_yaml_parser_set_input_string :: Parser@@ -151,6 +147,9 @@ c_fclose :: File -> IO () +foreign import ccall unsafe "&fclose_helper"+ c_fclose_helper :: FunPtr (File -> Parser -> IO ())+ withForeignPtr' :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b withForeignPtr' fp f = do r <- f $ unsafeForeignPtrToPtr fp@@ -457,16 +456,14 @@ deriving (Show, Typeable) instance Exception ToEventRawException -decode :: SC.StreamChunk c Event- => MonadCatchIO m- => B.ByteString- -> EnumeratorGM c Event m a+decode :: MonadCatchIO m => B.ByteString -> Enumerator Event m a decode bs i = do fp <- liftIO $ mallocForeignPtrBytes parserSize res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize- flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp+ a <- if (res == 0)- then return $ throwErr $ Err "Yaml out of memory"+ then throwError $ YamlException "Yaml out of memory" else do -- NOTE: can't replace the following with unsafeUseAsCString -- since it must run in a MonadIO let (fptr, offset, len) = B.toForeignPtr bs@@ -476,47 +473,43 @@ liftIO $ withForeignPtr fp $ \p -> c_yaml_parser_set_input_string p ptr' len' runParser fp i+ return a -decodeFile :: SC.StreamChunk c Event- => MonadCatchIO m- => FilePath- -> EnumeratorGM c Event m a+decodeFile :: MonadIO m => FilePath -> Enumerator Event m a decodeFile file i = do fp <- liftIO $ mallocForeignPtrBytes parserSize+ liftIO $ addForeignPtrFinalizer c_yaml_parser_delete fp res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize- flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $- if (res == 0)- then return $ throwErr $ Err "Yaml out of memory"+ a <-+ if res == 0+ then throwError $ YamlException "Yaml out of memory" else do file' <- liftIO $ withCString file $ \file' -> withCString "r" $ \r' -> c_fopen file' r'+ liftIO $ addForeignPtrFinalizerEnv c_fclose_helper file' fp if (file' == nullPtr)- then return $ throwErr $ Err+ then throwError $ YamlException $ "Yaml file not found: " ++ file else do liftIO $ withForeignPtr fp $ \p -> c_yaml_parser_set_input_file p file'- finally (runParser fp i) $ liftIO $ do- c_fclose file'- withForeignPtr fp c_yaml_parser_delete+ a <- runParser fp i+ return a+ return a -runParser :: SC.StreamChunk c Event- => MonadCatchIO m+runParser :: MonadIO m => ForeignPtr ParserStruct- -> IterateeG c Event m a- -> m (IterateeG c Event m a)-runParser fp iter = do+ -> Enumerator Event m a+runParser fp (Continue k) = do e <- liftIO $ withForeignPtr fp parserParseOne' case e of- Left err -> return $ throwErr $ Err $ show err- Right Nothing -> return iter+ Left err -> throwError $ YamlException err+ Right Nothing -> continue k Right (Just ev) -> do- igv <- runIter iter $ Chunk $ SC.fromList [ev]- case igv of- Done a _ -> return $ return a- Cont iter' Nothing -> runParser fp iter'- Cont _ (Just err) -> return $ throwErr err+ step' <- lift $ runIteratee $ k $ Chunks [ev]+ runParser fp step'+runParser _ step = returnI step parserParseOne' :: Parser -> IO (Either String (Maybe Event))@@ -539,19 +532,18 @@ ] else liftIO $ Right <$> getEvent er -encode :: SC.StreamChunk c Event- => MonadIO m- => IterateeG c Event m B.ByteString-encode = joinIM $ liftIO $ do- fp <- mallocForeignPtrBytes emitterSize- res <- withForeignPtr fp c_yaml_emitter_initialize- when (res == 0) $ fail "c_yaml_emitter_initialize failed"- buf <- mallocForeignPtrBytes bufferSize- withForeignPtr buf c_buffer_init- withForeignPtr fp $+encode :: MonadIO m => Iteratee Event m B.ByteString+encode = do+ fp <- liftIO $ mallocForeignPtrBytes emitterSize+ res <- liftIO $ withForeignPtr fp c_yaml_emitter_initialize+ when (res == 0) $ throwError+ $ YamlException "c_yaml_emitter_initialize failed"+ buf <- liftIO $ mallocForeignPtrBytes bufferSize+ liftIO $ withForeignPtr buf c_buffer_init+ liftIO $ withForeignPtr fp $ \emitter -> withForeignPtr buf $ \b -> c_my_emitter_set_output emitter b- return $ runEmitter (go buf) fp+ runEmitter (go buf) fp where go buf = withForeignPtr buf $ \b -> do ptr' <- c_get_buffer_buff b@@ -559,34 +551,37 @@ fptr <- newForeignPtr_ $ castPtr ptr' return $ B.fromForeignPtr fptr 0 $ fromIntegral len --encodeFile :: SC.StreamChunk c Event- => MonadIO m+encodeFile :: MonadIO m => FilePath- -> IterateeG c Event m ()-encodeFile filePath = joinIM $ liftIO $ do- fp <- mallocForeignPtrBytes emitterSize- res <- withForeignPtr fp c_yaml_emitter_initialize- when (res == 0) $ fail "c_yaml_emitter_initialize failed"- file <- withCString filePath $+ -> Iteratee Event m ()+encodeFile filePath = do+ fp <- liftIO $ mallocForeignPtrBytes emitterSize+ res <- liftIO $ withForeignPtr fp c_yaml_emitter_initialize+ when (res == 0) $ throwError+ $ YamlException "c_yaml_emitter_initialize failed"+ file <- liftIO $ withCString filePath $ \filePath' -> withCString "w" $ \w' -> c_fopen filePath' w'- when (file == nullPtr) $ fail $ "could not open file for write: " ++ filePath- withForeignPtr fp $ flip c_yaml_emitter_set_output_file file- return $ runEmitter (c_fclose file) fp+ when (file == nullPtr) $ throwError+ $ YamlException $ "could not open file for write: " ++ filePath+ liftIO $ withForeignPtr fp $ flip c_yaml_emitter_set_output_file file+ runEmitter (c_fclose file) fp -runEmitter :: SC.StreamChunk c Event- => MonadIO m+runEmitter :: MonadIO m => IO a -> ForeignPtr EmitterStruct- -> IterateeG c Event m a-runEmitter close fp = IterateeG go+ -> Iteratee Event m a+runEmitter close fp = continue go where- go (EOF x) = do+ go EOF = do liftIO $ withForeignPtr fp c_yaml_emitter_delete a <- liftIO close- return $ Done a $ EOF x- go (Chunk c) = do+ yield a EOF+ go (Chunks c) = do liftIO $ withForeignPtr fp $ \emitter ->- LL.mapM_ (\e -> toEventRaw e $ c_yaml_emitter_emit emitter) c- return $ Cont (runEmitter close fp) Nothing+ mapM_ (\e -> toEventRaw e $ c_yaml_emitter_emit emitter) c+ continue go++data YamlException = YamlException String+ deriving (Show, Typeable)+instance Exception YamlException
c/helper.c view
@@ -134,3 +134,8 @@ if (!in) return 0; yaml_parser_set_input_file(parser, in); }++int fclose_helper(FILE *file, yaml_parser_t *parser)+{+ return fclose(file);+}
runtests.hs view
@@ -8,7 +8,8 @@ import Test.Framework.Providers.HUnit import Test.HUnit hiding (Test, path) -import Data.Iteratee hiding (filter, length, foldl')+import qualified Data.Enumerator as E+import Data.Enumerator (($$)) import Data.List (foldl') import System.Directory@@ -28,21 +29,19 @@ , testCase "decode invalid document (without segfault)" caseDecodeInvalidDocument ] -counter :: (Event -> Bool) -> Int -> IterateeG [] Event IO Int+counter :: (Event -> Bool) -> Int -> E.Step Event IO Int counter pred' acc =- IterateeG go+ E.Continue go where- go (EOF x) = return $ Done acc $ EOF x- go (Chunk c) =- let acc' = length (filter pred' c) + acc- in return $ Cont (counter pred' acc') Nothing+ go E.EOF = E.yield acc E.EOF+ go (E.Chunks c) = E.returnI $ counter pred' $ length (filter pred' c) + acc caseHelper :: String -> (Event -> Bool) -> Int -> Assertion caseHelper yamlString pred' expRes = do- res <- decode (B8.pack yamlString) (counter pred' 0) >>= run+ Right res <- E.run $ decode (B8.pack yamlString) (counter pred' 0) res @?= expRes caseCountScalarsWithAnchor :: Assertion@@ -79,36 +78,34 @@ caseCountScalars :: Assertion caseCountScalars = do- res <- decode yamlBS (counter' accum) >>= run+ Right res <- E.run $ decode yamlBS $ counter' accum res @?= (7, 1, 2)- where- yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"- yamlBS = B8.pack yamlString- counter' acc = IterateeG $ \s ->- case s of- EOF x -> return $ Done acc $ EOF x- Chunk c ->- let acc' = foldl' adder acc c- in return $ Cont (counter' acc') Nothing- adder (s, l, m) (EventScalar{}) = (s + 1, l, m)- adder (s, l, m) (EventSequenceStart{}) = (s, l + 1, m)- adder (s, l, m) (EventMappingStart{}) = (s, l, m + 1)- adder a _ = a- accum = (0, 0, 0) :: (Int, Int, Int)+ where+ yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"+ yamlBS = B8.pack yamlString+ counter' acc = E.Continue $ \s ->+ case s of+ E.EOF -> E.yield acc E.EOF+ E.Chunks c -> E.returnI $ counter' $ foldl' adder acc c+ adder (s, l, m) (EventScalar{}) = (s + 1, l, m)+ adder (s, l, m) (EventSequenceStart{}) = (s, l + 1, m)+ adder (s, l, m) (EventMappingStart{}) = (s, l, m + 1)+ adder a _ = a+ accum = (0, 0, 0) :: (Int, Int, Int) caseLargestString :: Assertion caseLargestString = do- res <- decodeFile filePath (dec accum) >>= run+ Right res <- E.run $ decodeFile filePath $ dec accum res @?= (length expected, expected) where expected = "this one is just a little bit bigger than the others" filePath = "test/largest-string.yaml"- dec acc = IterateeG $ \s ->+ dec acc = E.Continue $ \s -> case s of- EOF x -> return $ Done acc $ EOF x- Chunk c ->+ E.EOF -> E.yield acc E.EOF+ E.Chunks c -> let acc' = foldl' adder acc c- in return $ Cont (dec acc') Nothing+ in E.returnI $ dec acc' adder (i, s) (EventScalar bs _ _ _) = let s' = B8.unpack bs i' = length s'@@ -124,17 +121,13 @@ caseEncodeDecode :: Assertion caseEncodeDecode = do- eList <- decode yamlBS (dec []) >>= run- bs <- enumPure1Chunk eList encode >>= run- eList2 <- decode bs (dec []) >>= run+ Right eList <- E.run $ decode yamlBS $$ E.consume+ Right bs <- E.run $ E.enumList 1 eList $$ encode+ Right eList2 <- E.run $ decode bs $$ E.consume map MyEvent eList @=? map MyEvent eList2- where- yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"- yamlBS = B8.pack yamlString- dec front = IterateeG $ \s ->- case s of- EOF x -> return $ Done front $ EOF x- Chunk c -> return $ Cont (dec $ front ++ c) Nothing+ where+ yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"+ yamlBS = B8.pack yamlString removeFile' :: FilePath -> IO () removeFile' fp = do@@ -144,46 +137,40 @@ caseEncodeDecodeFile :: Assertion caseEncodeDecodeFile = do removeFile' tmpPath- eList <- decodeFile filePath (dec []) >>= run- enumPure1Chunk eList (encodeFile tmpPath) >>= run- eList2 <- decodeFile filePath (dec []) >>= run+ Right eList <- E.run $ decodeFile filePath $$ E.consume+ E.run $ E.enumList 1 eList $$ encodeFile tmpPath+ Right eList2 <- E.run $ decodeFile filePath $$ E.consume map MyEvent eList @=? map MyEvent eList2- where- filePath = "test/largest-string.yaml"- tmpPath = "tmp.yaml"- dec front = IterateeG $ \s ->- case s of- EOF x -> return $ Done front $ EOF x- Chunk c -> return $ Cont (dec $ front ++ c) Nothing+ where+ filePath = "test/largest-string.yaml"+ tmpPath = "tmp.yaml" caseInterleave :: Assertion caseInterleave = do removeFile' tmpPath removeFile' tmpPath2- decodeFile filePath (encodeFile tmpPath :: IterateeG [] Event IO ()) >>= run- decodeFile tmpPath (encodeFile tmpPath2 :: IterateeG [] Event IO ()) >>= run+ Right () <- E.run $ decodeFile filePath $$ encodeFile tmpPath+ Right () <- E.run $ decodeFile tmpPath $$ encodeFile tmpPath2 f1 <- readFile tmpPath f2 <- readFile tmpPath2 f1 @=? f2- where- filePath = "test/largest-string.yaml"- tmpPath = "tmp.yaml"- tmpPath2 = "tmp2.yaml"+ where+ filePath = "test/largest-string.yaml"+ tmpPath = "tmp.yaml"+ tmpPath2 = "tmp2.yaml" caseDecodeInvalidDocument :: Assertion caseDecodeInvalidDocument = do- x <- decode yamlBS ignore- y <- runIter x $ EOF Nothing- case y of- Cont _ _ -> return ()- _ -> do+ x <- E.run $ decode yamlBS ignore+ case x of+ Left _ -> return ()+ Right y -> do putStrLn $ "bad return value: " ++ show y assertFailure "expected parsing exception, but got no errors" where yamlString = " - foo\n - baz\nbuz" yamlBS = B8.pack yamlString- ignore :: IterateeG [] Event IO ()- ignore = IterateeG $ \s ->+ ignore = E.Continue $ \s -> case s of- EOF x -> return $ Done () $ EOF x- Chunk _c -> return $ Cont ignore Nothing+ E.EOF -> E.yield () E.EOF+ E.Chunks _-> E.returnI ignore
yaml.cabal view
@@ -1,5 +1,5 @@ name: yaml-version: 0.3.0+version: 0.4.0 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>@@ -27,14 +27,13 @@ Buildable: False else Buildable: True- build-depends: base >= 4 && < 5,- transformers >= 0.1 && < 0.3,- bytestring >= 0.9.1.4 && < 0.10,- iteratee >= 0.3.5 && < 0.4,- MonadCatchIO-transformers >= 0.2.2 && < 0.3,- ListLike >= 1.0.1 && < 1.1+ build-depends: base >= 4 && < 5+ , transformers >= 0.1 && < 0.3+ , bytestring >= 0.9.1.4 && < 0.10+ , enumerator >= 0.4 && < 0.5+ , MonadCatchIO-transformers >= 0.2.2 && < 0.3 exposed-modules: Text.Libyaml- ghc-options: -Wall -auto-all -caf-all+ ghc-options: -Wall c-sources: c/helper.c, c/api.c, c/dumper.c,@@ -50,16 +49,15 @@ if flag(buildtests) Buildable: True cpp-options: -DTEST- build-depends: test-framework,- test-framework-hunit,- HUnit,- directory,- base >= 4 && < 5,- transformers >= 0.1 && < 0.3,- bytestring >= 0.9.1.4 && < 0.10,- iteratee >= 0.3.5 && < 0.4,- MonadCatchIO-transformers >= 0.2.2 && < 0.3,- ListLike >= 1.0.1 && < 1.1+ build-depends: test-framework+ , test-framework-hunit+ , HUnit+ , directory+ , base >= 4 && < 5+ , transformers >= 0.1 && < 0.3+ , bytestring >= 0.9.1.4 && < 0.10+ , enumerator >= 0.4 && < 0.5+ , MonadCatchIO-transformers >= 0.2.2 && < 0.3 else Buildable: False ghc-options: -Wall