Fix some "warn-unused-do-bind" warnings where we want to ignore the value

[ghc-base.git] / GHC / IO / Handle.hs

diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs
index b4b90e8..1531b4a 100644 (file)
--- a/GHC/IO/Handle.hs
+++ b/GHC/IO/Handle.hs
@@ -23,7 +23,7 @@ module GHC.IO.Handle (
  
    hFileSize, hSetFileSize, hIsEOF, hLookAhead,
    hSetBuffering, hSetBinaryMode, hSetEncoding,
-   hFlush, hDuplicate, hDuplicateTo,
+   hFlush, hFlushAll, hDuplicate, hDuplicateTo,
  
    hClose, hClose_help,
  
@@ -80,15 +80,17 @@ import Control.Monad
 hClose :: Handle -> IO ()
 hClose h@(FileHandle _ m)     = do 
   mb_exc <- hClose' h m
-  case mb_exc of
-    Nothing -> return ()
-    Just e  -> hClose_rethrow e h
+  hClose_maybethrow mb_exc h
 hClose h@(DuplexHandle _ r w) = do
   mb_exc1 <- hClose' h w
   mb_exc2 <- hClose' h r
-  case (do mb_exc1; mb_exc2) of
-     Nothing -> return ()
-     Just e  -> hClose_rethrow e h
+  case mb_exc1 of
+    Nothing -> return ()
+    Just e  -> hClose_maybethrow mb_exc2 h
+
+hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
+hClose_maybethrow Nothing  h  = return ()
+hClose_maybethrow (Just e) h = hClose_rethrow e h
 
 hClose_rethrow :: SomeException -> Handle -> IO ()
 hClose_rethrow e h = 
@@ -145,7 +147,7 @@ hSetFileSize handle size =
 hIsEOF :: Handle -> IO Bool
 hIsEOF handle =
   catch
-     (do hLookAhead handle; return False)
+     (hLookAhead handle >> return False)
      (\e -> if isEOFError e then return True else ioError e)
 
 -- ---------------------------------------------------------------------------
@@ -257,8 +259,10 @@ hSetEncoding :: Handle -> TextEncoding -> IO ()
 hSetEncoding hdl encoding = do
   withHandle "hSetEncoding" hdl $ \h_@Handle__{..} -> do
     flushCharBuffer h_
-    (mb_encoder,mb_decoder) <- getEncoding (Just encoding) haType
-    return (Handle__{ haDecoder = mb_decoder, haEncoder = mb_encoder, .. },
+    openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
+    bbuf <- readIORef haByteBuffer
+    ref <- newIORef (error "last_decode")
+    return (Handle__{ haLastDecode = ref, haDecoder = mb_decoder, haEncoder = mb_encoder, .. },
             ())
 
 -- -----------------------------------------------------------------------------
@@ -278,6 +282,26 @@ hSetEncoding hdl encoding = do
 hFlush :: Handle -> IO () 
 hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
 
+-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
+-- including any buffered read data.  Buffered read data is flushed
+-- by seeking the file position back to the point before the bufferred
+-- data was read, and hence only works if @hdl@ is seekable (see
+-- 'hIsSeekable').
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full;
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+--    It is unspecified whether the characters in the buffer are discarded
+--    or retained under these circumstances;
+--
+--  * 'isIllegalOperation' if @hdl@ has buffered read data, and is not
+--    seekable.
+
+hFlushAll :: Handle -> IO () 
+hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
+
 -- -----------------------------------------------------------------------------
 -- Repositioning Handles
 
@@ -511,15 +535,21 @@ hSetBinaryMode handle bin =
   withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
     do 
          flushBuffer h_
+
          let mb_te | bin       = Nothing
                    | otherwise = Just localeEncoding
 
+         openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
+
          -- should match the default newline mode, whatever that is
          let nl    | bin       = noNewlineTranslation
                    | otherwise = nativeNewlineMode
 
-         (mb_encoder, mb_decoder) <- getEncoding mb_te haType
-         return Handle__{ haEncoder  = mb_encoder, 
+         bbuf <- readIORef haByteBuffer
+         ref <- newIORef (error "codec_state", bbuf)
+
+         return Handle__{ haLastDecode = ref,
+                          haEncoder  = mb_encoder, 
                           haDecoder  = mb_decoder,
                           haInputNL  = inputNL nl,
                           haOutputNL = outputNL nl, .. }
@@ -638,7 +668,7 @@ dupHandleTo filepath h other_side
   case cast devTo of
     Nothing   -> ioe_dupHandlesNotCompatible h
     Just dev' -> do 
-      IODevice.dup2 dev dev'
+      _ <- IODevice.dup2 dev dev'
       FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
       takeMVar m