@@ -19,8 +19,9 @@ module Text.Libyaml
1919 -- * Higher level functions
2020 , encode
2121 , decode
22− -- FIXME encodeFile
23− , decodeFile
22+ -- FIXME , encodeFile
23+ -- FIXME , decodeFile
24+ , withFileParser
2425 ) where
2526
2627import qualified Data.ByteString.Internal as B
@@ -33,10 +34,8 @@ import Foreign.Ptr
3334import Foreign.ForeignPtr
3435import Foreign.Marshal.Alloc
3536
36−import Data.Attempt -- exports failure
37−
38−import Data.Convertible.Text
3937import Control.Applicative
38+import Control.Failure
4039
4140import Control.Exception (throwIO, Exception)
4241import Data.Typeable (Typeable)
@@ -172,11 +171,14 @@ withFileParser fp f = allocaBytes parserSize $ \p ->
172171 c_yaml_parser_delete p
173172 return ret
174173
175−withParser :: B.ByteString -> (Parser -> IO a) -> IO a
176−withParser bs f = allocaBytes parserSize $ \p ->
177− do
178− res <- c_yaml_parser_initialize p
179− when (res == 0) $ throwIO YamlOutOfMemory
174+withParser :: B.ByteString
175+ -> (Parser -> IO (Either YamlException a))
176+ -> IO (Either YamlException a)
177+withParser bs f = allocaBytes parserSize $ \p -> do
178+ res <- c_yaml_parser_initialize p
179+ if res == 0
180+ then return (Left YamlOutOfMemory)
181+ else do
180182 let (fptr, offset, len) = B.toForeignPtr bs
181183 ret <- withForeignPtr fptr $ \ptr ->
182184 do
@@ -184,7 +186,7 @@ withParser bs f = allocaBytes parserSize $ \p ->
184186 len' = fromIntegral len
185187 c_yaml_parser_set_input_string p ptr' len'
186188 f p
187− c_yaml_parser_delete p
189+ c_yaml_parser_delete p -- FIXME use finally
188190 return ret
189191
190192withEventRaw :: (EventRaw -> IO a) -> IO a
@@ -208,9 +210,7 @@ foreign import ccall unsafe "get_parser_error_offset"
208210makeString :: (a -> IO (Ptr CUChar)) -> a -> IO String
209211makeString f a = do
210212 cchar <- castPtr `fmap` f a
211− len <- fromIntegral `fmap` B.c_strlen cchar
212− bs <- B.create len $ \dest -> B.memcpy dest (castPtr cchar) (fromIntegral len)
213− return $ convertSuccess bs
213+ peekCString cchar
214214
215215parserParseOne :: MonadFailure YamlException m
216216 => Parser
@@ -308,21 +308,18 @@ instance Monad YAttempt where
308308instance Failure YamlException YAttempt where
309309 failure = YFailure
310310
311−parserParse :: MonadFailure YamlException m
312− => Parser
313− -> IO (m [Event])
314−parserParse parser = do
311+parserParse :: (a -> Event -> Either a a)
312+ -> a
313+ -> Parser
314+ -> IO (Either YamlException a)
315+parserParse fold accum parser = do
315316 event' <- parserParseOne parser
316317 case event' of
317− YFailure e -> return $ failure e
318− YSuccess event ->
319− case event of
320− EventStreamEnd -> return $ return [event]
321− _ -> do
322− rest <- parserParse parser
323− case rest of
324− YFailure e -> return $ failure e
325− YSuccess rest' -> return $ return $ event : rest'
318+ YFailure e -> return $ Left e
319+ YSuccess event -> do
320+ case fold accum event of
321+ Left accum' -> return $ Right accum'
322+ Right accum' -> parserParse fold accum' parser
326323
327324-- Emitter
328325
@@ -514,12 +511,17 @@ encode :: MonadFailure YamlException m
514511 -> IO (m B.ByteString)
515512encode = withEmitter . flip emitEvents
516513
517−decode :: MonadFailure YamlException m
518− => B.ByteString
519− -> IO (m [Event])
520−decode bs = withParser bs parserParse
514+-- FIXME encodeFile
515+
516+decode :: B.ByteString
517+ -> (a -> Event -> Either a a)
518+ -> a
519+ -> IO (Either YamlException a)
520+decode bs fold accum = withParser bs $ parserParse fold accum
521521
522+{- FIXME
522523decodeFile :: MonadFailure YamlException m
523524 => FilePath
524525 -> IO (m [Event])
525526decodeFile fp = withFileParser fp parserParse
527+-}