Do not encode UTF-8 LF when writing

src/Data/Text/IO.hs

@@ -57,6 +57,7 @@ import Data.Text.Internal.IO (hGetLineWith, readChunk)
 import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
                       RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,
                       writeCharBuf)
+import GHC.IO.Encoding.Types (textEncodingName)
 import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))
 import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,
                                 wantWritableHandle)
@@ -65,6 +66,8 @@ import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
                             HandleType(..), Newline(..))
 import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)
 import System.IO.Error (isEOFError)
+import qualified Data.ByteString.Char8 as B
+import Data.Text.Encoding (encodeUtf8)
 
 -- | The 'readFile' function reads a file and returns the contents of
 -- the file as a string.  The entire file is read strictly, as with
@@ -176,17 +179,24 @@ hGetLine = hGetLineWith T.concat
 hPutStr :: Handle -> Text -> IO ()
 -- This function is lifted almost verbatim from GHC.IO.Handle.Text.
 hPutStr h t = do
-  (buffer_mode, nl) <-
+  (buffer_mode, nl, isUTF8) <-
        wantWritableHandle "hPutStr" h $ \h_ -> do
                      bmode <- getSpareBuffer h_
-                     return (bmode, haOutputNL h_)
-  let str = stream t
+                     let isUTF8 = maybe False ((== "UTF-8") . textEncodingName) $ haCodec h_
+                     return (bmode, haOutputNL h_, isUTF8)
+  let l = T.length t
+      str = stream t
   case buffer_mode of
-     (NoBuffering, _)        -> hPutChars h str
-     (LineBuffering, buf)    -> writeLines h nl buf str
-     (BlockBuffering _, buf)
-         | nl == CRLF        -> writeBlocksCRLF h buf str
-         | otherwise         -> writeBlocksRaw h buf str
+    (NoBuffering, _)
+      | l > 5 && nl == LF && isUTF8   -> utf8Put
+      | otherwise                     -> hPutChars h str
+    _ | l > 80 && nl == LF && isUTF8  -> utf8Put
+    (LineBuffering, bufC)             -> writeLines h nl bufC str
+    (BlockBuffering _, bufC)
+        | nl == CRLF                  -> writeBlocksCRLF h bufC str
+        | otherwise                   -> writeBlocksRaw h bufC str
+
+  where utf8Put = B.hPutStr h $ encodeUtf8 t
 
 hPutChars :: Handle -> Stream Char -> IO ()
 hPutChars h (Stream next0 s0 _len) = loop s0