From: Simon Marlow <marlowsd@gmail.com>
Date: Wed, 15 Jul 2009 12:25:19 +0000 (+0000)
Subject: Add hGetEncoding :: Handle -> IO (Maybe TextEncoding)
X-Git-Tag: ghc-darcs-git-switchover~349
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=36544e286811d7ae98870fd427ff379fb47336c1;p=ghc-base.git

Add hGetEncoding :: Handle -> IO (Maybe TextEncoding)
as suggested during the discussion on the libraries list
---

diff --git a/GHC/IO/Handle.hs b/GHC/IO/Handle.hs
index 969b805..d87deef 100644
--- a/GHC/IO/Handle.hs
+++ b/GHC/IO/Handle.hs
@@ -22,7 +22,7 @@ module GHC.IO.Handle (
    mkFileHandle, mkDuplexHandle,
  
    hFileSize, hSetFileSize, hIsEOF, hLookAhead,
-   hSetBuffering, hSetBinaryMode, hSetEncoding,
+   hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
    hFlush, hFlushAll, hDuplicate, hDuplicateTo,
  
    hClose, hClose_help,
@@ -264,9 +264,25 @@ hSetEncoding hdl encoding = do
     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, .. },
+    return (Handle__{ haLastDecode = ref, 
+                      haDecoder = mb_decoder, 
+                      haEncoder = mb_encoder,
+                      haCodec   = Just encoding, .. },
             ())
 
+-- | Return the current 'TextEncoding' for the specified 'Handle', or
+-- 'Nothing' if the 'Handle' is in binary mode.
+--
+-- Note that the 'TextEncoding' remembers nothing about the state of
+-- the encoder/decoder in use on this 'Handle'.  For example, if the
+-- encoding in use is UTF-16, then using 'hGetEncoding' and
+-- 'hSetEncoding' to save and restore the encoding may result in an
+-- extra byte-order-mark being written to the file.
+--
+hGetEncoding :: Handle -> IO (Maybe TextEncoding)
+hGetEncoding hdl =
+  withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
+
 -- -----------------------------------------------------------------------------
 -- hFlush
 
@@ -553,6 +569,7 @@ hSetBinaryMode handle bin =
          return Handle__{ haLastDecode = ref,
                           haEncoder  = mb_encoder, 
                           haDecoder  = mb_decoder,
+                          haCodec    = mb_te,
                           haInputNL  = inputNL nl,
                           haOutputNL = outputNL nl, .. }
   
diff --git a/GHC/IO/Handle/Internals.hs b/GHC/IO/Handle/Internals.hs
index 6fb66c7..0de07f4 100644
--- a/GHC/IO/Handle/Internals.hs
+++ b/GHC/IO/Handle/Internals.hs
@@ -521,6 +521,7 @@ mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
                         haBuffers = spares,
                         haEncoder = mb_encoder,
                         haDecoder = mb_decoder,
+                        haCodec = mb_codec,
                         haInputNL = inputNL nl,
                         haOutputNL = outputNL nl,
                         haOtherSide = other_side
diff --git a/GHC/IO/Handle/Types.hs b/GHC/IO/Handle/Types.hs
index a45f298..6566619 100644
--- a/GHC/IO/Handle/Types.hs
+++ b/GHC/IO/Handle/Types.hs
@@ -132,6 +132,7 @@ data Handle__
       haBuffers     :: !(IORef (BufferList CharBufElem)),  -- spare buffers
       haEncoder     :: Maybe (TextEncoder enc_state),
       haDecoder     :: Maybe (TextDecoder dec_state),
+      haCodec       :: Maybe TextEncoding,
       haInputNL     :: Newline,
       haOutputNL    :: Newline,
       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
diff --git a/System/IO.hs b/System/IO.hs
index 4467974..f4bcfb5 100644
--- a/System/IO.hs
+++ b/System/IO.hs
@@ -179,6 +179,7 @@ module System.IO (
     -- termination of the character stream, as with other I/O errors.
 
     hSetEncoding, 
+    hGetEncoding,
 
     -- ** Unicode encodings
     TextEncoding,