diff options
| author | Hideyuki Tanaka <tanaka.hideyuki@gmail.com> | 2010-05-04 16:22:04 +0900 |
|---|---|---|
| committer | Hideyuki Tanaka <tanaka.hideyuki@gmail.com> | 2010-05-04 16:22:04 +0900 |
| commit | 674c26d9c7213744193d8dd9b5269be66a80c4d5 (patch) | |
| tree | 9dcb162961050af23af64814a9717f904b6c339c /haskell | |
| parent | 7b68b04efdd400b9d851201ae4d7ba47f30e74e2 (diff) | |
| download | msgpack-python-674c26d9c7213744193d8dd9b5269be66a80c4d5.tar.gz | |
fix feed function from Handle
Diffstat (limited to 'haskell')
| -rw-r--r-- | haskell/msgpack.cabal | 2 | ||||
| -rw-r--r-- | haskell/src/Data/MessagePack/Feed.hs | 12 | ||||
| -rw-r--r-- | haskell/src/Data/MessagePack/Monad.hs | 17 |
3 files changed, 19 insertions, 12 deletions
diff --git a/haskell/msgpack.cabal b/haskell/msgpack.cabal index 505a2b9..31cad3b 100644 --- a/haskell/msgpack.cabal +++ b/haskell/msgpack.cabal @@ -1,5 +1,5 @@ Name: msgpack -Version: 0.2.0 +Version: 0.2.1 License: BSD3 License-File: LICENSE Author: Hideyuki Tanaka diff --git a/haskell/src/Data/MessagePack/Feed.hs b/haskell/src/Data/MessagePack/Feed.hs index afd3f6c..93bdd9b 100644 --- a/haskell/src/Data/MessagePack/Feed.hs +++ b/haskell/src/Data/MessagePack/Feed.hs @@ -33,12 +33,16 @@ type Feeder = IO (Maybe ByteString) -- | Feeder from Handle feederFromHandle :: Handle -> IO Feeder feederFromHandle h = return $ do - bs <- BS.hGet h bufSize + bs <- BS.hGetNonBlocking h bufSize if BS.length bs > 0 - then return $ Just bs + then do return $ Just bs else do - hClose h - return Nothing + bs <- BS.hGet h 1 + if BS.length bs > 0 + then do return $ Just bs + else do + hClose h + return Nothing where bufSize = 4096 diff --git a/haskell/src/Data/MessagePack/Monad.hs b/haskell/src/Data/MessagePack/Monad.hs index bf1514f..cf3a0fd 100644 --- a/haskell/src/Data/MessagePack/Monad.hs +++ b/haskell/src/Data/MessagePack/Monad.hs @@ -115,18 +115,21 @@ instance MonadIO m => MonadIO (UnpackerT m) where instance MonadIO m => MonadUnpacker (UnpackerT m) where get = UnpackerT $ \up feed -> liftIO $ do - resp <- unpackerExecute up - guard $ resp>=0 - when (resp==0) $ do - Just bs <- feed - unpackerFeed up bs - resp2 <- unpackerExecute up - guard $ resp2==1 + executeOne up feed obj <- unpackerData up freeZone =<< unpackerReleaseZone up unpackerReset up let Right r = fromObject obj 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. unpackFrom :: MonadIO m => Feeder -> UnpackerT m r -> m r |