7196316 · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Converted to enumerator

7196316Michael Snoyman16 years ago

Text/Libyaml.hs+65−72

compare with master

unifiedsplit

@@ -35,19 +35,13 @@ import Foreign.ForeignPtr

35import Foreign.Marshal.Alloc

36import Data.Data

38−#if MIN_VERSION_transformers(0,2,0)

38+import Control.Monad.IO.Class

39−import "transformers" Control.Monad.IO.Class

39+import Control.Monad.Trans.Class (lift)

40−#else

41−import "transformers" Control.Monad.Trans

42−#endif

44import Control.Exception (throwIO, Exception)

41import Control.Exception (throwIO, Exception)

45−import Data.Iteratee

42+import Data.Enumerator

46−import qualified Data.Iteratee.Base.StreamChunk as SC

47import Control.Applicative

43import Control.Applicative

48−import Control.Monad.CatchIO (MonadCatchIO, finally)

44+import "MonadCatchIO-transformers" Control.Monad.CatchIO (MonadCatchIO, finally)

49−

50−import qualified Data.ListLike as LL

52data Event =

46data Event =

53 EventStreamStart

47 EventStreamStart

@@ -457,16 +451,13 @@ newtype ToEventRawException = ToEventRawException CInt

457 deriving (Show, Typeable)

451 deriving (Show, Typeable)

458instance Exception ToEventRawException

452instance Exception ToEventRawException

459

453

460−decode :: SC.StreamChunk c Event

461− => MonadCatchIO m

454+decode :: MonadCatchIO m => B.ByteString -> Enumerator Event m a

462− => B.ByteString

463− -> EnumeratorGM c Event m a

464decode bs i = do

455decode bs i = do

465 fp <- liftIO $ mallocForeignPtrBytes parserSize

456 fp <- liftIO $ mallocForeignPtrBytes parserSize

466 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

457 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

467− flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $

458+ a <-

468 if (res == 0)

459 if (res == 0)

469− then return $ throwErr $ Err "Yaml out of memory"

460+ then throwError $ YamlException "Yaml out of memory"

470 else do -- NOTE: can't replace the following with unsafeUseAsCString

461 else do -- NOTE: can't replace the following with unsafeUseAsCString

471 -- since it must run in a MonadIO

462 -- since it must run in a MonadIO

472 let (fptr, offset, len) = B.toForeignPtr bs

463 let (fptr, offset, len) = B.toForeignPtr bs

@@ -476,47 +467,47 @@ decode bs i = do

476 liftIO $ withForeignPtr fp $ \p ->

467 liftIO $ withForeignPtr fp $ \p ->

477 c_yaml_parser_set_input_string p ptr' len'

468 c_yaml_parser_set_input_string p ptr' len'

478 runParser fp i

469 runParser fp i

470+ liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally

471+ return a

479

472

480−decodeFile :: SC.StreamChunk c Event

473+-- FIXME decodeFile :: MonadCatchIO m => FilePath -> Enumerator Event m a

481− => MonadCatchIO m

474+decodeFile :: FilePath -> Enumerator Event IO a

482− => FilePath

483− -> EnumeratorGM c Event m a

484decodeFile file i = do

475decodeFile file i = do

485 fp <- liftIO $ mallocForeignPtrBytes parserSize

476 fp <- liftIO $ mallocForeignPtrBytes parserSize

486 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

477 res <- liftIO $ withForeignPtr fp c_yaml_parser_initialize

487− flip finally (liftIO $ withForeignPtr fp c_yaml_parser_delete) $

478+ a <-

488− if (res == 0)

479+ if res == 0

489− then return $ throwErr $ Err "Yaml out of memory"

480+ then throwError $ YamlException "Yaml out of memory"

490 else do

481 else do

491 file' <- liftIO

482 file' <- liftIO

492 $ withCString file $ \file' -> withCString "r" $ \r' ->

483 $ withCString file $ \file' -> withCString "r" $ \r' ->

493 c_fopen file' r'

484 c_fopen file' r'

494 if (file' == nullPtr)

485 if (file' == nullPtr)

495− then return $ throwErr $ Err

486+ then throwError $ YamlException

496 $ "Yaml file not found: " ++ file

487 $ "Yaml file not found: " ++ file

497 else do

488 else do

498 liftIO $ withForeignPtr fp $ \p ->

489 liftIO $ withForeignPtr fp $ \p ->

499 c_yaml_parser_set_input_file p file'

490 c_yaml_parser_set_input_file p file'

500− finally (runParser fp i) $ liftIO $ do

491+ a <- runParser fp i

492+ -- FIXME finally

501− c_fclose file'

493+ liftIO $ c_fclose file'

502− withForeignPtr fp c_yaml_parser_delete

494+ liftIO $ withForeignPtr fp c_yaml_parser_delete

503−

495+ return a

504−runParser :: SC.StreamChunk c Event

496+ liftIO $ withForeignPtr fp c_yaml_parser_delete -- FIXME finally

497+ return a

498+

505− => MonadCatchIO m

499+runParser :: MonadCatchIO m

506 => ForeignPtr ParserStruct

500 => ForeignPtr ParserStruct

507− -> IterateeG c Event m a

508− -> m (IterateeG c Event m a)

501+ -> Enumerator Event m a

509−runParser fp iter = do

502+runParser fp (Continue k) = do

510 e <- liftIO $ withForeignPtr fp parserParseOne'

503 e <- liftIO $ withForeignPtr fp parserParseOne'

511 case e of

504 case e of

512− Left err -> return $ throwErr $ Err $ show err

505+ Left err -> throwError $ YamlException err

513− Right Nothing -> return iter

506+ Right Nothing -> continue k

514 Right (Just ev) -> do

507 Right (Just ev) -> do

515− igv <- runIter iter $ Chunk $ SC.fromList [ev]

508+ step' <- lift $ runIteratee $ k $ Chunks [ev]

516− case igv of

517− Done a _ -> return $ return a

518− Cont iter' Nothing -> runParser fp iter'

509+ runParser fp step'

519− Cont _ (Just err) -> return $ throwErr err

510+runParser _ step = returnI step

520

511

521parserParseOne' :: Parser

512parserParseOne' :: Parser

522 -> IO (Either String (Maybe Event))

513 -> IO (Either String (Maybe Event))

@@ -539,19 +530,18 @@ parserParseOne' parser = allocaBytes eventSize $ \er -> do

539 ]

530 ]

540 else liftIO $ Right <$> getEvent er

531 else liftIO $ Right <$> getEvent er

541

532

542−encode :: SC.StreamChunk c Event

543− => MonadIO m

544− => IterateeG c Event m B.ByteString

533+encode :: MonadIO m => Iteratee Event m B.ByteString

545−encode = joinIM $ liftIO $ do

534+encode = do

546− fp <- mallocForeignPtrBytes emitterSize

535+ fp <- liftIO $ mallocForeignPtrBytes emitterSize

547− res <- withForeignPtr fp c_yaml_emitter_initialize

536+ res <- liftIO $ withForeignPtr fp c_yaml_emitter_initialize

537+ when (res == 0) $ throwError

548− when (res == 0) $ fail "c_yaml_emitter_initialize failed"

538+ $ YamlException "c_yaml_emitter_initialize failed"

549− buf <- mallocForeignPtrBytes bufferSize

539+ buf <- liftIO $ mallocForeignPtrBytes bufferSize

550− withForeignPtr buf c_buffer_init

540+ liftIO $ withForeignPtr buf c_buffer_init

551− withForeignPtr fp $

541+ liftIO $ withForeignPtr fp $

552 \emitter -> withForeignPtr buf $

542 \emitter -> withForeignPtr buf $

553 \b -> c_my_emitter_set_output emitter b

543 \b -> c_my_emitter_set_output emitter b

554− return $ runEmitter (go buf) fp

544+ runEmitter (go buf) fp

555 where

545 where

556 go buf = withForeignPtr buf $ \b -> do

546 go buf = withForeignPtr buf $ \b -> do

557 ptr' <- c_get_buffer_buff b

547 ptr' <- c_get_buffer_buff b

@@ -559,34 +549,37 @@ encode = joinIM $ liftIO $ do

559 fptr <- newForeignPtr_ $ castPtr ptr'

549 fptr <- newForeignPtr_ $ castPtr ptr'

560 return $ B.fromForeignPtr fptr 0 $ fromIntegral len

550 return $ B.fromForeignPtr fptr 0 $ fromIntegral len

561

551

562−

563−encodeFile :: SC.StreamChunk c Event

564− => MonadIO m

552+encodeFile :: MonadIO m

565 => FilePath

553 => FilePath

566− -> IterateeG c Event m ()

554+ -> Iteratee Event m ()

567−encodeFile filePath = joinIM $ liftIO $ do

555+encodeFile filePath = do

568− fp <- mallocForeignPtrBytes emitterSize

556+ fp <- liftIO $ mallocForeignPtrBytes emitterSize

569− res <- withForeignPtr fp c_yaml_emitter_initialize

557+ res <- liftIO $ withForeignPtr fp c_yaml_emitter_initialize

558+ when (res == 0) $ throwError

570− when (res == 0) $ fail "c_yaml_emitter_initialize failed"

559+ $ YamlException "c_yaml_emitter_initialize failed"

571− file <- withCString filePath $

560+ file <- liftIO $ withCString filePath $

572 \filePath' -> withCString "w" $

561 \filePath' -> withCString "w" $

573 \w' -> c_fopen filePath' w'

562 \w' -> c_fopen filePath' w'

563+ when (file == nullPtr) $ throwError

574− when (file == nullPtr) $ fail $ "could not open file for write: " ++ filePath

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

575− withForeignPtr fp $ flip c_yaml_emitter_set_output_file file

565+ liftIO $ withForeignPtr fp $ flip c_yaml_emitter_set_output_file file

576− return $ runEmitter (c_fclose file) fp

566+ runEmitter (c_fclose file) fp

577

567

578−runEmitter :: SC.StreamChunk c Event

579− => MonadIO m

568+runEmitter :: MonadIO m

580 => IO a

569 => IO a

581 -> ForeignPtr EmitterStruct

570 -> ForeignPtr EmitterStruct

582− -> IterateeG c Event m a

571+ -> Iteratee Event m a

583−runEmitter close fp = IterateeG go

572+runEmitter close fp = continue go

584 where

573 where

585− go (EOF x) = do

574+ go EOF = do

586 liftIO $ withForeignPtr fp c_yaml_emitter_delete

575 liftIO $ withForeignPtr fp c_yaml_emitter_delete

587 a <- liftIO close

576 a <- liftIO close

588− return $ Done a $ EOF x

577+ yield a EOF

589− go (Chunk c) = do

578+ go (Chunks c) = do

590 liftIO $ withForeignPtr fp $ \emitter ->

579 liftIO $ withForeignPtr fp $ \emitter ->

591− LL.mapM_ (\e -> toEventRaw e $ c_yaml_emitter_emit emitter) c

580+ mapM_ (\e -> toEventRaw e $ c_yaml_emitter_emit emitter) c

592− return $ Cont (runEmitter close fp) Nothing

581+ continue go

582+

583+data YamlException = YamlException String

584+ deriving (Show, Typeable)

585+instance Exception YamlException

runtests.hs+50−63

@@ -8,7 +8,8 @@ import qualified Data.ByteString.Char8 as B8

8import Test.Framework.Providers.HUnit

9import Test.HUnit hiding (Test, path)

11−import Data.Iteratee hiding (filter, length, foldl')

11+import qualified Data.Enumerator as E

12+import Data.Enumerator (($$))

12import Data.List (foldl')

13import Data.List (foldl')

14import System.Directory

15import System.Directory

@@ -28,21 +29,19 @@ main = defaultMain

28 , testCase "decode invalid document (without segfault)" caseDecodeInvalidDocument

29 , testCase "decode invalid document (without segfault)" caseDecodeInvalidDocument

29 ]

30 ]

31−counter :: (Event -> Bool) -> Int -> IterateeG [] Event IO Int

32+counter :: (Event -> Bool) -> Int -> E.Step Event IO Int

32counter pred' acc =

33counter pred' acc =

33− IterateeG go

34+ E.Continue go

34 where

35 where

35− go (EOF x) = return $ Done acc $ EOF x

36+ go E.EOF = E.yield acc E.EOF

36− go (Chunk c) =

37− let acc' = length (filter pred' c) + acc

37+ go (E.Chunks c) = E.returnI $ counter pred' $ length (filter pred' c) + acc

38− in return $ Cont (counter pred' acc') Nothing

40caseHelper :: String

39caseHelper :: String

41 -> (Event -> Bool)

40 -> (Event -> Bool)

42 -> Int

41 -> Int

43 -> Assertion

42 -> Assertion

44caseHelper yamlString pred' expRes = do

43caseHelper yamlString pred' expRes = do

45− res <- decode (B8.pack yamlString) (counter pred' 0) >>= run

44+ Right res <- E.run $ decode (B8.pack yamlString) (counter pred' 0)

46 res @?= expRes

45 res @?= expRes

48caseCountScalarsWithAnchor :: Assertion

47caseCountScalarsWithAnchor :: Assertion

@@ -79,36 +78,34 @@ caseCountAliases =

80caseCountScalars :: Assertion

79caseCountScalars :: Assertion

81caseCountScalars = do

80caseCountScalars = do

82− res <- decode yamlBS (counter' accum) >>= run

81+ Right res <- E.run $ decode yamlBS $ counter' accum

83 res @?= (7, 1, 2)

82 res @?= (7, 1, 2)

84− where

83+ where

85− yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"

84+ yamlString = "foo:\n baz: [bin1, bin2, bin3]\nbaz: bazval"

86− yamlBS = B8.pack yamlString

85+ yamlBS = B8.pack yamlString

87− counter' acc = IterateeG $ \s ->

86+ counter' acc = E.Continue $ \s ->

88− case s of

87+ case s of

89− EOF x -> return $ Done acc $ EOF x

88+ E.EOF -> E.yield acc E.EOF

90− Chunk c ->

91− let acc' = foldl' adder acc c

89+ E.Chunks c -> E.returnI $ counter' $ foldl' adder acc c

92− in return $ Cont (counter' acc') Nothing

93− adder (s, l, m) (EventScalar{}) = (s + 1, l, m)

90+ adder (s, l, m) (EventScalar{}) = (s + 1, l, m)

94− adder (s, l, m) (EventSequenceStart{}) = (s, l + 1, m)

91+ adder (s, l, m) (EventSequenceStart{}) = (s, l + 1, m)

95− adder (s, l, m) (EventMappingStart{}) = (s, l, m + 1)

92+ adder (s, l, m) (EventMappingStart{}) = (s, l, m + 1)

96− adder a _ = a

93+ adder a _ = a

97− accum = (0, 0, 0) :: (Int, Int, Int)

94+ accum = (0, 0, 0) :: (Int, Int, Int)

99caseLargestString :: Assertion

96caseLargestString :: Assertion

100caseLargestString = do

97caseLargestString = do

101− res <- decodeFile filePath (dec accum) >>= run

98+ Right res <- E.run $ decodeFile filePath $ dec accum

102 res @?= (length expected, expected)

99 res @?= (length expected, expected)

103 where

100 where

104 expected = "this one is just a little bit bigger than the others"

101 expected = "this one is just a little bit bigger than the others"

105 filePath = "test/largest-string.yaml"

102 filePath = "test/largest-string.yaml"

106− dec acc = IterateeG $ \s ->

103+ dec acc = E.Continue $ \s ->

107 case s of

104 case s of

108− EOF x -> return $ Done acc $ EOF x

105+ E.EOF -> E.yield acc E.EOF

109− Chunk c ->

106+ E.Chunks c ->

110 let acc' = foldl' adder acc c

107 let acc' = foldl' adder acc c

111− in return $ Cont (dec acc') Nothing

108+ in E.returnI $ dec acc'

112 adder (i, s) (EventScalar bs _ _ _) =

109 adder (i, s) (EventScalar bs _ _ _) =

113 let s' = B8.unpack bs

110 let s' = B8.unpack bs

114 i' = length s'

111 i' = length s'

@@ -124,17 +121,13 @@ instance Eq MyEvent where

124

121

125caseEncodeDecode :: Assertion

122caseEncodeDecode :: Assertion

126caseEncodeDecode = do

123caseEncodeDecode = do

127− eList <- decode yamlBS (dec []) >>= run

124+ Right eList <- E.run $ decode yamlBS $$ E.consume

128− bs <- enumPure1Chunk eList encode >>= run

125+ Right bs <- E.run $ E.enumList 1 eList $$ encode

129− eList2 <- decode bs (dec []) >>= run

126+ Right eList2 <- E.run $ decode bs $$ E.consume

130 map MyEvent eList @=? map MyEvent eList2

127 map MyEvent eList @=? map MyEvent eList2

131− where

128+ where

132− yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"

129+ yamlString = "foo: bar\nbaz:\n - bin1\n - bin2\n"

133− yamlBS = B8.pack yamlString

130+ yamlBS = B8.pack yamlString

134− dec front = IterateeG $ \s ->

135− case s of

136− EOF x -> return $ Done front $ EOF x

137− Chunk c -> return $ Cont (dec $ front ++ c) Nothing

138

131

139removeFile' :: FilePath -> IO ()

132removeFile' :: FilePath -> IO ()

140removeFile' fp = do

133removeFile' fp = do

@@ -144,46 +137,40 @@ removeFile' fp = do

144caseEncodeDecodeFile :: Assertion

137caseEncodeDecodeFile :: Assertion

145caseEncodeDecodeFile = do

138caseEncodeDecodeFile = do

146 removeFile' tmpPath

139 removeFile' tmpPath

147− eList <- decodeFile filePath (dec []) >>= run

140+ Right eList <- E.run $ decodeFile filePath $$ E.consume

148− enumPure1Chunk eList (encodeFile tmpPath) >>= run

141+ E.run $ E.enumList 1 eList $$ encodeFile tmpPath

149− eList2 <- decodeFile filePath (dec []) >>= run

142+ Right eList2 <- E.run $ decodeFile filePath $$ E.consume

150 map MyEvent eList @=? map MyEvent eList2

143 map MyEvent eList @=? map MyEvent eList2

151− where

144+ where

152− filePath = "test/largest-string.yaml"

145+ filePath = "test/largest-string.yaml"

153− tmpPath = "tmp.yaml"

146+ tmpPath = "tmp.yaml"

154− dec front = IterateeG $ \s ->

155− case s of

156− EOF x -> return $ Done front $ EOF x

157− Chunk c -> return $ Cont (dec $ front ++ c) Nothing

158

147

159caseInterleave :: Assertion

148caseInterleave :: Assertion

160caseInterleave = do

149caseInterleave = do

161 removeFile' tmpPath

150 removeFile' tmpPath

162 removeFile' tmpPath2

151 removeFile' tmpPath2

163− decodeFile filePath (encodeFile tmpPath :: IterateeG [] Event IO ()) >>= run

152+ Right () <- E.run $ decodeFile filePath $$ encodeFile tmpPath

164− decodeFile tmpPath (encodeFile tmpPath2 :: IterateeG [] Event IO ()) >>= run

153+ Right () <- E.run $ decodeFile tmpPath $$ encodeFile tmpPath2

165 f1 <- readFile tmpPath

154 f1 <- readFile tmpPath

166 f2 <- readFile tmpPath2

155 f2 <- readFile tmpPath2

167 f1 @=? f2

156 f1 @=? f2

168− where

157+ where

169− filePath = "test/largest-string.yaml"

158+ filePath = "test/largest-string.yaml"

170− tmpPath = "tmp.yaml"

159+ tmpPath = "tmp.yaml"

171− tmpPath2 = "tmp2.yaml"

160+ tmpPath2 = "tmp2.yaml"

172

161

173caseDecodeInvalidDocument :: Assertion

162caseDecodeInvalidDocument :: Assertion

174caseDecodeInvalidDocument = do

163caseDecodeInvalidDocument = do

175− x <- decode yamlBS ignore

164+ x <- E.run $ decode yamlBS ignore

176− y <- runIter x $ EOF Nothing

177− case y of

165+ case x of

178− Cont _ _ -> return ()

166+ Left _ -> return ()

179− _ -> do

167+ Right y -> do

180 putStrLn $ "bad return value: " ++ show y

168 putStrLn $ "bad return value: " ++ show y

181 assertFailure "expected parsing exception, but got no errors"

169 assertFailure "expected parsing exception, but got no errors"

182 where

170 where

183 yamlString = " - foo\n - baz\nbuz"

171 yamlString = " - foo\n - baz\nbuz"

184 yamlBS = B8.pack yamlString

172 yamlBS = B8.pack yamlString

185− ignore :: IterateeG [] Event IO ()

173+ ignore = E.Continue $ \s ->

186− ignore = IterateeG $ \s ->

187 case s of

174 case s of

188− EOF x -> return $ Done () $ EOF x

175+ E.EOF -> E.yield () E.EOF

189− Chunk _c -> return $ Cont ignore Nothing

176+ E.Chunks _-> E.returnI ignore

yaml.cabal+16−18

@@ -1,5 +1,5 @@

1name: yaml

2−version: 0.3.0

2+version: 0.4.0

3license: BSD3

4license-file: LICENSE

5author: Michael Snoyman <michael@snoyman.com>, Anton Ageev <antage@gmail.com>

@@ -27,14 +27,13 @@ library

27 Buildable: False

28 else

29 Buildable: True

30− build-depends: base >= 4 && < 5,

30+ build-depends: base >= 4 && < 5

31− transformers >= 0.1 && < 0.3,

31+ , transformers >= 0.1 && < 0.3

32− bytestring >= 0.9.1.4 && < 0.10,

32+ , bytestring >= 0.9.1.4 && < 0.10

33− iteratee >= 0.3.5 && < 0.4,

33+ , enumerator >= 0.4 && < 0.5

34− MonadCatchIO-transformers >= 0.2.2 && < 0.3,

34+ , MonadCatchIO-transformers >= 0.2.2 && < 0.3

35− ListLike >= 1.0.1 && < 1.1

36 exposed-modules: Text.Libyaml

35 exposed-modules: Text.Libyaml

37− ghc-options: -Wall -auto-all -caf-all

36+ ghc-options: -Wall

38 c-sources: c/helper.c,

37 c-sources: c/helper.c,

39 c/api.c,

38 c/api.c,

40 c/dumper.c,

39 c/dumper.c,

@@ -50,16 +49,15 @@ executable runtests

50 if flag(buildtests)

49 if flag(buildtests)

51 Buildable: True

50 Buildable: True

52 cpp-options: -DTEST

51 cpp-options: -DTEST

53− build-depends: test-framework,

52+ build-depends: test-framework

54− test-framework-hunit,

53+ , test-framework-hunit

55− HUnit,

54+ , HUnit

56− directory,

55+ , directory

57− base >= 4 && < 5,

56+ , base >= 4 && < 5

58− transformers >= 0.1 && < 0.3,

57+ , transformers >= 0.1 && < 0.3

59− bytestring >= 0.9.1.4 && < 0.10,

58+ , bytestring >= 0.9.1.4 && < 0.10

60− iteratee >= 0.3.5 && < 0.4,

59+ , enumerator >= 0.4 && < 0.5

61− MonadCatchIO-transformers >= 0.2.2 && < 0.3,

60+ , MonadCatchIO-transformers >= 0.2.2 && < 0.3

62− ListLike >= 1.0.1 && < 1.1

63 else

61 else

64 Buildable: False

62 Buildable: False

65 ghc-options: -Wall

63 ghc-options: -Wall