b11333d · typeable/yaml

git.iko.soy/typeable/yaml

on master help sign in

Iterator type for decode

b11333dMichael Snoyman17 years ago

Text/Libyaml.hs+33−31

compare with master

unifiedsplit

@@ -19,8 +19,9 @@ module Text.Libyaml

19 -- * Higher level functions

20 , encode

21 , decode

22− -- FIXME encodeFile

22+ -- FIXME , encodeFile

23− , decodeFile

23+ -- FIXME , decodeFile

24+ , withFileParser

24 ) where

25 ) where

26import qualified Data.ByteString.Internal as B

27import qualified Data.ByteString.Internal as B

@@ -33,10 +34,8 @@ import Foreign.Ptr

33import Foreign.ForeignPtr

34import Foreign.ForeignPtr

34import Foreign.Marshal.Alloc

35import Foreign.Marshal.Alloc

36−import Data.Attempt -- exports failure

37−

38−import Data.Convertible.Text

39import Control.Applicative

37import Control.Applicative

38+import Control.Failure

41import Control.Exception (throwIO, Exception)

40import Control.Exception (throwIO, Exception)

42import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

@@ -172,11 +171,14 @@ withFileParser fp f = allocaBytes parserSize $ \p ->

172 c_yaml_parser_delete p

171 c_yaml_parser_delete p

173 return ret

172 return ret

174

173

175−withParser :: B.ByteString -> (Parser -> IO a) -> IO a

174+withParser :: B.ByteString

175+ -> (Parser -> IO (Either YamlException a))

176+ -> IO (Either YamlException a)

176−withParser bs f = allocaBytes parserSize $ \p ->

177+withParser bs f = allocaBytes parserSize $ \p -> do

177− do

178− res <- c_yaml_parser_initialize p

178+ res <- c_yaml_parser_initialize p

179+ if res == 0

179− when (res == 0) $ throwIO YamlOutOfMemory

180+ then return (Left YamlOutOfMemory)

181+ else do

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

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

181 ret <- withForeignPtr fptr $ \ptr ->

183 ret <- withForeignPtr fptr $ \ptr ->

182 do

184 do

@@ -184,7 +186,7 @@ withParser bs f = allocaBytes parserSize $ \p ->

184 len' = fromIntegral len

186 len' = fromIntegral len

185 c_yaml_parser_set_input_string p ptr' len'

187 c_yaml_parser_set_input_string p ptr' len'

186 f p

188 f p

187− c_yaml_parser_delete p

189+ c_yaml_parser_delete p -- FIXME use finally

188 return ret

190 return ret

189

191

190withEventRaw :: (EventRaw -> IO a) -> IO a

192withEventRaw :: (EventRaw -> IO a) -> IO a

@@ -208,9 +210,7 @@ foreign import ccall unsafe "get_parser_error_offset"

208makeString :: (a -> IO (Ptr CUChar)) -> a -> IO String

210makeString :: (a -> IO (Ptr CUChar)) -> a -> IO String

209makeString f a = do

211makeString f a = do

210 cchar <- castPtr `fmap` f a

212 cchar <- castPtr `fmap` f a

211− len <- fromIntegral `fmap` B.c_strlen cchar

213+ peekCString cchar

212− bs <- B.create len $ \dest -> B.memcpy dest (castPtr cchar) (fromIntegral len)

213− return $ convertSuccess bs

214

215parserParseOne :: MonadFailure YamlException m

216 => Parser

@@ -308,21 +308,18 @@ instance Monad YAttempt where

308instance Failure YamlException YAttempt where

309 failure = YFailure

310

311−parserParse :: MonadFailure YamlException m

311+parserParse :: (a -> Event -> Either a a)

312+ -> a

312− => Parser

313+ -> Parser

313− -> IO (m [Event])

314+ -> IO (Either YamlException a)

314−parserParse parser = do

315+parserParse fold accum parser = do

315 event' <- parserParseOne parser

316 event' <- parserParseOne parser

316 case event' of

317 case event' of

317− YFailure e -> return $ failure e

318+ YFailure e -> return $ Left e

318− YSuccess event ->

319+ YSuccess event -> do

319− case event of

320+ case fold accum event of

320− EventStreamEnd -> return $ return [event]

321+ Left accum' -> return $ Right accum'

321− _ -> do

322− rest <- parserParse parser

322+ Right accum' -> parserParse fold accum' parser

323− case rest of

324− YFailure e -> return $ failure e

325− YSuccess rest' -> return $ return $ event : rest'

326

323

327-- Emitter

324-- Emitter

328

325

@@ -514,12 +511,17 @@ encode :: MonadFailure YamlException m

514 -> IO (m B.ByteString)

511 -> IO (m B.ByteString)

515encode = withEmitter . flip emitEvents

512encode = withEmitter . flip emitEvents

516

513

517−decode :: MonadFailure YamlException m

514+-- FIXME encodeFile

515+

518− => B.ByteString

516+decode :: B.ByteString

519− -> IO (m [Event])

517+ -> (a -> Event -> Either a a)

518+ -> a

519+ -> IO (Either YamlException a)

520−decode bs = withParser bs parserParse

520+decode bs fold accum = withParser bs $ parserParse fold accum

521

522+{- FIXME

522decodeFile :: MonadFailure YamlException m

523decodeFile :: MonadFailure YamlException m

523 => FilePath

524 => FilePath

524 -> IO (m [Event])

525 -> IO (m [Event])

525decodeFile fp = withFileParser fp parserParse

526decodeFile fp = withFileParser fp parserParse

527+-}

yaml.cabal+1−4

@@ -28,11 +28,8 @@ library

28 else

29 Buildable: True

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

31− data-object >= 0.2.0 && < 0.3,

32 bytestring >= 0.9.1.4 && < 0.10,

31 bytestring >= 0.9.1.4 && < 0.10,

33− text >= 0.5 && < 0.6,

32+ failure >= 0.0.0 && < 0.1

34− convertible-text >= 0.2.0 && < 0.3,

35− attempt >= 0.2.0 && < 0.3

36 exposed-modules: Text.Libyaml

33 exposed-modules: Text.Libyaml

37 ghc-options: -Wall

34 ghc-options: -Wall

38 c-sources: c/helper.c,

35 c-sources: c/helper.c,