From 674c26d9c7213744193d8dd9b5269be66a80c4d5 Mon Sep 17 00:00:00 2001
From: Hideyuki Tanaka <tanaka.hideyuki@gmail.com>
Date: Tue, 4 May 2010 16:22:04 +0900
Subject: [PATCH] fix feed function from Handle

---
 haskell/msgpack.cabal                 |  2 +-
 haskell/src/Data/MessagePack/Feed.hs  | 12 ++++++++----
 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 505a2b98..31cad3bc 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 afd3f6c5..93bdd9b5 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 bf1514fa..cf3a0fd9 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