fix feed function from Handle

This commit is contained in:
Hideyuki Tanaka 2010-05-04 16:22:04 +09:00
parent 7b68b04efd
commit 674c26d9c7
3 changed files with 19 additions and 12 deletions

View File

@ -1,5 +1,5 @@
Name: msgpack Name: msgpack
Version: 0.2.0 Version: 0.2.1
License: BSD3 License: BSD3
License-File: LICENSE License-File: LICENSE
Author: Hideyuki Tanaka Author: Hideyuki Tanaka

View File

@ -33,12 +33,16 @@ type Feeder = IO (Maybe ByteString)
-- | Feeder from Handle -- | Feeder from Handle
feederFromHandle :: Handle -> IO Feeder feederFromHandle :: Handle -> IO Feeder
feederFromHandle h = return $ do feederFromHandle h = return $ do
bs <- BS.hGet h bufSize bs <- BS.hGetNonBlocking h bufSize
if BS.length bs > 0 if BS.length bs > 0
then return $ Just bs then do return $ Just bs
else do else do
hClose h bs <- BS.hGet h 1
return Nothing if BS.length bs > 0
then do return $ Just bs
else do
hClose h
return Nothing
where where
bufSize = 4096 bufSize = 4096

View File

@ -115,18 +115,21 @@ instance MonadIO m => MonadIO (UnpackerT m) where
instance MonadIO m => MonadUnpacker (UnpackerT m) where instance MonadIO m => MonadUnpacker (UnpackerT m) where
get = UnpackerT $ \up feed -> liftIO $ do get = UnpackerT $ \up feed -> liftIO $ do
resp <- unpackerExecute up executeOne up feed
guard $ resp>=0
when (resp==0) $ do
Just bs <- feed
unpackerFeed up bs
resp2 <- unpackerExecute up
guard $ resp2==1
obj <- unpackerData up obj <- unpackerData up
freeZone =<< unpackerReleaseZone up freeZone =<< unpackerReleaseZone up
unpackerReset up unpackerReset up
let Right r = fromObject obj let Right r = fromObject obj
return r return r
where
executeOne up feed = do
resp <- unpackerExecute up
guard $ resp>=0
when (resp==0) $ do
Just bs <- feed
unpackerFeed up bs
executeOne up feed
-- | Execute deserializer using given feeder. -- | Execute deserializer using given feeder.
unpackFrom :: MonadIO m => Feeder -> UnpackerT m r -> m r unpackFrom :: MonadIO m => Feeder -> UnpackerT m r -> m r