X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FIO%2FHandle%2FText.hs;h=0d0e05b4d5fc93119730580e0f434ba9b1db505e;hb=4c889c7daa98daff7aec5c0e4ccf491f25f5d10c;hp=1e41a7b9b07ddd1a02b28f8325bd6f7eaf87642a;hpb=5522b142e24b9dbba21a9036746db20e78cf8f43;p=ghc-base.git

diff --git a/GHC/IO/Handle/Text.hs b/GHC/IO/Handle/Text.hs
index 1e41a7b..0d0e05b 100644
--- a/GHC/IO/Handle/Text.hs
+++ b/GHC/IO/Handle/Text.hs
@@ -1,7 +1,15 @@
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , RecordWildCards
+           , BangPatterns
+           , PatternGuards
+           , NondecreasingIndentation
+           , MagicHash
+           , ForeignFunctionInterface
+  #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
 {-# OPTIONS_HADDOCK hide #-}
-{-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -30,6 +38,7 @@ import GHC.IO.FD
 import GHC.IO.Buffer
 import qualified GHC.IO.BufferedIO as Buffered
 import GHC.IO.Exception
+import GHC.IO.Encoding.Failure (surrogatifyRoundtripCharacter, desurrogatifyRoundtripCharacter)
 import GHC.Exception
 import GHC.IO.Handle.Types
 import GHC.IO.Handle.Internals
@@ -39,6 +48,7 @@ import qualified GHC.IO.Device as RawIO
 import Foreign
 import Foreign.C
 
+import qualified Control.Exception as Exception
 import Data.Typeable
 import System.IO.Error
 import Data.Maybe
@@ -240,12 +250,12 @@ hGetLineBufferedLoop handle_@Handle__{..}
 
 maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
 maybeFillReadBuffer handle_ buf
-  = catch 
+  = Exception.catch
      (do buf' <- getSomeCharacters handle_ buf
          return (Just buf')
      )
-     (\e -> do if isEOFError e 
-                  then return Nothing 
+     (\e -> do if isEOFError e
+                  then return Nothing
                   else ioError e)
 
 -- See GHC.IO.Buffer
@@ -270,10 +280,10 @@ unpack !buf !r !w acc0
                  else do c1 <- peekElemOff pbuf (i-1)
                          let c = (fromIntegral c1 - 0xd800) * 0x400 +
                                  (fromIntegral c2 - 0xdc00) + 0x10000
-                         unpackRB (unsafeChr c : acc) (i-2)
+                         unpackRB (desurrogatifyRoundtripCharacter (unsafeChr c) : acc) (i-2)
 #else
               c <- peekElemOff pbuf i
-              unpackRB (c:acc) (i-1)
+              unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1)
 #endif
      in
      unpackRB acc0 (w-1)
@@ -296,7 +306,7 @@ unpack_nl !buf !r !w acc0
                             then unpackRB ('\n':acc) (i-2)
                             else unpackRB ('\n':acc) (i-1)
                  else do
-                         unpackRB (c:acc) (i-1)
+                         unpackRB (desurrogatifyRoundtripCharacter c:acc) (i-1)
      in do
      c <- peekElemOff pbuf (w-1)
      if (c == '\r')
@@ -370,8 +380,8 @@ lazyRead handle =
 lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
 lazyReadBuffered h handle_@Handle__{..} = do
    buf <- readIORef haCharBuffer
-   catch 
-        (do 
+   Exception.catch
+        (do
             buf'@Buffer{..} <- getSomeCharacters handle_ buf
             lazy_rest <- lazyRead h
             (s,r) <- if haInputNL == CRLF
@@ -576,7 +586,7 @@ writeBlocks hdl line_buffered add_nl nl
            else do
                shoveString n' cs rest
      | otherwise = do
-        n' <- writeCharBuf raw n c
+        n' <- writeCharBuf raw n (surrogatifyRoundtripCharacter c)
         shoveString n' cs rest
   in
   shoveString 0 s (if add_nl then "\n" else "")
@@ -857,7 +867,7 @@ hGetBufSome h ptr count
                                         -- that bufReadNBNonEmpty will not
                                         -- issue another read.
             else
-              bufReadNBEmpty h_ buf (castPtr ptr) 0 count
+              bufReadNBNonEmpty h_ buf (castPtr ptr) 0 count
 
 haFD :: Handle__ -> FD
 haFD h_@Handle__{..} =