[commit: bytestring] master: Add implementation of builder internal hPut for old or non-ghc Handle (193a624)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/193a6248f6a30f3fc6e6a4ed54633c2cede3d4dd

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

commit 193a6248f6a30f3fc6e6a4ed54633c2cede3d4dd
Author: Duncan Coutts <duncan at community.haskell.org>
Date:   Wed Nov 16 23:27:29 2011 +0000

    Add implementation of builder internal hPut for old or non-ghc Handle
    The current hPut is specific to newer GHC with the new Unicode Handle
    stuff. Provide an implementation for older ghc and non-ghc compilers.

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

 Data/ByteString/Lazy/Builder/Internal.hs |   21 +++++++++++++++++----
 1 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/Data/ByteString/Lazy/Builder/Internal.hs b/Data/ByteString/Lazy/Builder/Internal.hs
index 042ac86..4497d68 100644
--- a/Data/ByteString/Lazy/Builder/Internal.hs
+++ b/Data/ByteString/Lazy/Builder/Internal.hs
@@ -121,12 +121,16 @@ import qualified Data.ByteString               as S
 import qualified Data.ByteString.Internal      as S
 import qualified Data.ByteString.Lazy.Internal as L
 
+#if __GLASGOW_HASKELL__ >= 611
 import GHC.IO.Buffer (Buffer(..), newByteBuffer)
 import GHC.IO.Handle.Internals (wantWritableHandle, flushWriteBuffer)
 import GHC.IO.Handle.Types (Handle__, haByteBuffer, haBufferMode)
-import GHC.IORef
-
-import System.IO (Handle, hFlush, BufferMode(..))
+import System.IO (hFlush, BufferMode(..))
+import Data.IORef
+#else
+import qualified Data.ByteString.Lazy as L
+#endif
+import System.IO (Handle)
 
 #if MIN_VERSION_base(4,4,0)
 import Foreign hiding (unsafePerformIO, unsafeForeignPtrToPtr)
@@ -415,6 +419,7 @@ putLiftIO io = put $ \k br -> io >>= (`k` br)
 -- buffer is too small to execute one step of the 'Put' action, then
 -- it is replaced with a large enough buffer.
 hPut :: forall a. Handle -> Put a -> IO a
+#if __GLASGOW_HASKELL__ >= 611
 hPut h p = do
     fillHandle 1 (runPut p)
   where
@@ -504,7 +509,15 @@ hPut h p = do
                         L.foldrChunks (\c rest -> S.hPut h c >> rest) (return ())
                                       (lbsC L.Empty)
                         fillHandle 1 nextStep
-
+#else
+hPut h p =
+    go =<< buildStepToCIOS strategy (return . Finished) (runPut p)
+  where
+    go (Finished k)       = return k
+    go (Yield1 bs io)     = S.hPut h bs >> io >>= go
+    go (YieldC _ lbsC io) = L.hPut h (lbsC L.Empty) >> io >>= go
+    strategy = untrimmedStrategy L.smallChunkSize L.defaultChunkSize
+#endif
 
 ------------------------------------------------------------------------------
 -- ByteString insertion / controlling chunk boundaries