[commit: packages/binary] master: Bug fix isolate; keep labels from within failing isolate (f7ffedd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/binary

On branch  : master
Link       : http://git.haskell.org/packages/binary.git/commitdiff/f7ffeddd183984bf88b98c7d444b109dd156c8a1

>---------------------------------------------------------------

commit f7ffeddd183984bf88b98c7d444b109dd156c8a1
Author: Lennart Kolmodin <kolmodin at gmail.com>
Date:   Sun May 11 13:24:01 2014 +0400

    Bug fix isolate; keep labels from within failing isolate
    
    When an isolated decoder failed due to over consuming input, any
    labels set within that decoder were lost since demanding
    more input would fail within the isolate-decoder runner and not in
    the isolated decoder itself.
    With this change the signal of lack of more input is passed
    into the isolated decoder which in turn will fail, keeping any
    labels up to that point.


>---------------------------------------------------------------

f7ffeddd183984bf88b98c7d444b109dd156c8a1
 src/Data/Binary/Get/Internal.hs | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/Data/Binary/Get/Internal.hs b/src/Data/Binary/Get/Internal.hs
index 84ae199..03305ea 100644
--- a/src/Data/Binary/Get/Internal.hs
+++ b/src/Data/Binary/Get/Internal.hs
@@ -202,11 +202,16 @@ isolate n0 act
                  " which is less than the expected " ++ show n0 ++ " bytes"
   go 0 (Partial resume) = go 0 (resume Nothing)
   go n (Partial resume) = do
-    ensureN 1
-    inp <- get
-    let (inp', out) = B.splitAt n inp
-    put out
-    go (n - B.length inp') (resume (Just inp'))
+    inp <- C $ \inp k -> do
+      let takeLimited str =
+            let (inp', out) = B.splitAt n str
+            in k out (Just inp')
+      case not (B.null inp) of
+        True -> takeLimited inp
+        False -> prompt inp (k B.empty Nothing) takeLimited
+    case inp of
+      Nothing -> go n (resume Nothing)
+      Just str -> go (n - B.length str) (resume (Just str))
   go _ (Fail bs err) = pushFront bs >> fail err
   go n (BytesRead r resume) =
     go n (resume $! fromIntegral n0 - fromIntegral n - r)