Commit b5500775 authored by batterseapower's avatar batterseapower

Make the fileSystemEncoding/localeEncoding/foreignEncoding mutable

parent 59ecd68d
......@@ -147,7 +147,7 @@ peekCString :: CString -> IO String
#ifndef __GLASGOW_HASKELL__
peekCString = peekCAString
#else
peekCString = GHC.peekCString foreignEncoding
peekCString s = getForeignEncoding >>= flip GHC.peekCString s
#endif
-- | Marshal a C string with explicit length into a Haskell string.
......@@ -156,7 +156,7 @@ peekCStringLen :: CStringLen -> IO String
#ifndef __GLASGOW_HASKELL__
peekCStringLen = peekCAStringLen
#else
peekCStringLen = GHC.peekCStringLen foreignEncoding
peekCStringLen s = getForeignEncoding >>= flip GHC.peekCStringLen s
#endif
-- | Marshal a Haskell string into a NUL terminated C string.
......@@ -171,7 +171,7 @@ newCString :: String -> IO CString
#ifndef __GLASGOW_HASKELL__
newCString = newCAString
#else
newCString = GHC.newCString foreignEncoding
newCString s = getForeignEncoding >>= flip GHC.newCString s
#endif
-- | Marshal a Haskell string into a C string (ie, character array) with
......@@ -185,7 +185,7 @@ newCStringLen :: String -> IO CStringLen
#ifndef __GLASGOW_HASKELL__
newCStringLen = newCAStringLen
#else
newCStringLen = GHC.newCStringLen foreignEncoding
newCStringLen s = getForeignEncoding >>= flip GHC.newCStringLen s
#endif
-- | Marshal a Haskell string into a NUL terminated C string using temporary
......@@ -201,7 +201,7 @@ withCString :: String -> (CString -> IO a) -> IO a
#ifndef __GLASGOW_HASKELL__
withCString = withCAString
#else
withCString = GHC.withCString foreignEncoding
withCString s f = getForeignEncoding >>= \enc -> GHC.withCString enc s f
#endif
-- | Marshal a Haskell string into a C string (ie, character array)
......@@ -215,7 +215,7 @@ withCStringLen :: String -> (CStringLen -> IO a) -> IO a
#ifndef __GLASGOW_HASKELL__
withCStringLen = withCAStringLen
#else
withCStringLen = GHC.withCStringLen foreignEncoding
withCStringLen s f = getForeignEncoding >>= \enc -> GHC.withCStringLen enc s f
#endif
......@@ -230,7 +230,7 @@ charIsRepresentable c = return (ord c < 256)
-- -- | Determines whether a character can be accurately encoded in a 'CString'.
-- -- Unrepresentable characters are converted to '?' or their nearest visual equivalent.
charIsRepresentable :: Char -> IO Bool
charIsRepresentable = GHC.charIsRepresentable foreignEncoding
charIsRepresentable c = getForeignEncoding >>= flip GHC.charIsRepresentable c
#endif
-- single byte characters
......
......@@ -45,7 +45,8 @@ getFullArgs =
getFullProgArgv p_argc p_argv
p <- fromIntegral `liftM` peek p_argc
argv <- peek p_argv
peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
enc <- getFileSystemEncoding
peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
foreign import ccall unsafe "getFullProgArgv"
getFullProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
......
......@@ -22,7 +22,9 @@ module GHC.IO.Encoding (
utf8, utf8_bom,
utf16, utf16le, utf16be,
utf32, utf32le, utf32be,
localeEncoding, fileSystemEncoding, foreignEncoding,
initLocaleEncoding,
getLocaleEncoding, getFileSystemEncoding, getForeignEncoding,
setLocaleEncoding, setFileSystemEncoding, setForeignEncoding,
char8,
mkTextEncoding,
) where
......@@ -45,6 +47,7 @@ import qualified GHC.IO.Encoding.UTF8 as UTF8
import qualified GHC.IO.Encoding.UTF16 as UTF16
import qualified GHC.IO.Encoding.UTF32 as UTF32
import Data.IORef
import Data.Char (toUpper)
import Data.List
import Data.Maybe
......@@ -100,7 +103,7 @@ utf32be :: TextEncoding
utf32be = UTF32.utf32be
-- | The Unicode encoding of the current locale
localeEncoding :: TextEncoding
getLocaleEncoding :: IO TextEncoding
-- | The Unicode encoding of the current locale, but allowing arbitrary
-- undecodable bytes to be round-tripped through it.
......@@ -111,12 +114,24 @@ localeEncoding :: TextEncoding
-- On Windows, this encoding *should not* be used if possible because
-- the use of code pages is deprecated: Strings should be retrieved
-- via the "wide" W-family of UTF-16 APIs instead
fileSystemEncoding :: TextEncoding
getFileSystemEncoding :: IO TextEncoding
-- | The Unicode encoding of the current locale, but where undecodable
-- bytes are replaced with their closest visual match. Used for
-- the 'CString' marshalling functions in "Foreign.C.String"
foreignEncoding :: TextEncoding
getForeignEncoding :: IO TextEncoding
setLocaleEncoding, setFileSystemEncoding, setForeignEncoding :: TextEncoding -> IO ()
(getLocaleEncoding, setLocaleEncoding) = mkGlobal initLocaleEncoding
(getFileSystemEncoding, setFileSystemEncoding) = mkGlobal initFileSystemEncoding
(getForeignEncoding, setForeignEncoding) = mkGlobal initForeignEncoding
mkGlobal :: a -> (IO a, a -> IO ())
mkGlobal x = unsafePerformIO $ do
x_ref <- newIORef x
return (readIORef x_ref, writeIORef x_ref)
initLocaleEncoding, initFileSystemEncoding, initForeignEncoding :: TextEncoding
#if !defined(mingw32_HOST_OS)
-- It is rather important that we don't just call Iconv.mkIconvEncoding here
......@@ -129,13 +144,13 @@ foreignEncoding :: TextEncoding
-- FIXME: this is not a complete solution because if the locale encoding is one
-- which we don't have a Haskell-side decoder for, iconv might still ignore the
-- lone surrogate in the input.
localeEncoding = unsafePerformIO $ mkTextEncoding' ErrorOnCodingFailure Iconv.localeEncodingName
fileSystemEncoding = unsafePerformIO $ mkTextEncoding' RoundtripFailure Iconv.localeEncodingName
foreignEncoding = unsafePerformIO $ mkTextEncoding' IgnoreCodingFailure Iconv.localeEncodingName
initLocaleEncoding = unsafePerformIO $ mkTextEncoding' ErrorOnCodingFailure Iconv.localeEncodingName
initFileSystemEncoding = unsafePerformIO $ mkTextEncoding' RoundtripFailure Iconv.localeEncodingName
initForeignEncoding = unsafePerformIO $ mkTextEncoding' IgnoreCodingFailure Iconv.localeEncodingName
#else
localeEncoding = CodePage.localeEncoding
fileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure
foreignEncoding = CodePage.mkLocaleEncoding IgnoreCodingFailure
initLocaleEncoding = CodePage.localeEncoding
initFileSystemEncoding = CodePage.mkLocaleEncoding RoundtripFailure
initForeignEncoding = CodePage.mkLocaleEncoding IgnoreCodingFailure
#endif
-- | An encoding in which Unicode code points are translated to bytes
......
......@@ -3,7 +3,8 @@
module GHC.IO.Encoding where
import GHC.IO (IO)
import GHC.IO.Encoding.Types
localeEncoding, fileSystemEncoding, foreignEncoding :: TextEncoding
getLocaleEncoding, getFileSystemEncoding, getForeignEncoding :: IO TextEncoding
......@@ -562,8 +562,8 @@ hSetBinaryMode handle bin =
flushCharBuffer h_
closeTextCodecs h_
let mb_te | bin = Nothing
| otherwise = Just localeEncoding
mb_te <- if bin then return Nothing
else fmap Just getLocaleEncoding
openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
......@@ -639,7 +639,7 @@ dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
-> IO Handle
dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do
-- XXX wrong!
let mb_codec = if isJust haEncoder then Just localeEncoding else Nothing
mb_codec <- if isJust haEncoder then fmap Just getLocaleEncoding else return Nothing
mkHandle new_dev filepath haType True{-buffered-} mb_codec
NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
mb_finalizer other_side
......
......@@ -52,7 +52,8 @@ stdin :: Handle
stdin = unsafePerformIO $ do
-- ToDo: acquire lock
setBinaryMode FD.stdin
mkHandle FD.stdin "<stdin>" ReadHandle True (Just localeEncoding)
enc <- getLocaleEncoding
mkHandle FD.stdin "<stdin>" ReadHandle True (Just enc)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
......@@ -62,7 +63,8 @@ stdout :: Handle
stdout = unsafePerformIO $ do
-- ToDo: acquire lock
setBinaryMode FD.stdout
mkHandle FD.stdout "<stdout>" WriteHandle True (Just localeEncoding)
enc <- getLocaleEncoding
mkHandle FD.stdout "<stdout>" WriteHandle True (Just enc)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
......@@ -72,8 +74,9 @@ stderr :: Handle
stderr = unsafePerformIO $ do
-- ToDo: acquire lock
setBinaryMode FD.stderr
enc <- getLocaleEncoding
mkHandle FD.stderr "<stderr>" WriteHandle False{-stderr is unbuffered-}
(Just localeEncoding)
(Just enc)
nativeNewlineMode{-translate newlines-}
(Just stdHandleFinalizer) Nothing
......@@ -179,7 +182,7 @@ openFile' filepath iomode binary non_blocking = do
-- first open the file to get an FD
(fd, fd_type) <- FD.openFile filepath iomode non_blocking
let mb_codec = if binary then Nothing else Just localeEncoding
mb_codec <- if binary then return Nothing else fmap Just getLocaleEncoding
-- then use it to make a Handle
mkHandleFromFD fd fd_type filepath iomode
......@@ -253,8 +256,8 @@ fdToHandle' fdint mb_type is_socket filepath iomode binary = do
(fd,fd_type) <- FD.mkFD fdint iomode mb_stat
is_socket
is_socket
mkHandleFromFD fd fd_type filepath iomode is_socket
(if binary then Nothing else Just localeEncoding)
enc <- if binary then return Nothing else fmap Just getLocaleEncoding
mkHandleFromFD fd fd_type filepath iomode is_socket enc
-- | Turn an existing file descriptor into a Handle. This is used by
......
......@@ -37,7 +37,7 @@ import Foreign.C
import Control.Exception.Base ( bracket )
-- import GHC.IO
import GHC.IO.Exception
import GHC.IO.Encoding (fileSystemEncoding)
import GHC.IO.Encoding (getFileSystemEncoding)
import qualified GHC.Foreign as GHC
import Data.List
#ifdef mingw32_HOST_OS
......@@ -127,7 +127,8 @@ getArgs =
getProgArgv p_argc p_argv
p <- fromIntegral `liftM` peek p_argc
argv <- peek p_argv
peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString fileSystemEncoding)
enc <- getFileSystemEncoding
peekArray (p - 1) (advancePtr argv 1) >>= mapM (GHC.peekCString enc)
foreign import ccall unsafe "getProgArgv"
getProgArgv :: Ptr CInt -> Ptr (Ptr CString) -> IO ()
......@@ -157,7 +158,8 @@ getProgName =
unpackProgName :: Ptr (Ptr CChar) -> IO String -- argv[0]
unpackProgName argv = do
s <- peekElemOff argv 0 >>= GHC.peekCString fileSystemEncoding
enc <- getFileSystemEncoding
s <- peekElemOff argv 0 >>= GHC.peekCString enc
return (basename s)
#endif
......@@ -213,7 +215,7 @@ getEnv name =
withCString name $ \s -> do
litstring <- c_getenv s
if litstring /= nullPtr
then GHC.peekCString fileSystemEncoding litstring
then getFileSystemEncoding >>= \enc -> GHC.peekCString enc litstring
else ioe_missingEnvVar name
foreign import ccall unsafe "getenv"
......@@ -273,7 +275,8 @@ freeProgArgv argv = do
setProgArgv :: [String] -> IO (Ptr CString)
setProgArgv argv = do
vs <- mapM (GHC.newCString fileSystemEncoding) argv >>= newArray0 nullPtr
enc <- getFileSystemEncoding
vs <- mapM (GHC.newCString enc) argv >>= newArray0 nullPtr
c_setProgArgv (genericLength argv) vs
return vs
......@@ -323,7 +326,8 @@ getEnvironment = do
pBlock <- getEnvBlock
if pBlock == nullPtr then return []
else do
stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString fileSystemEncoding)
enc <- getFileSystemEncoding
stuff <- peekArray0 nullPtr pBlock >>= mapM (GHC.peekCString enc)
return (map divvy stuff)
foreign import ccall unsafe "__hscore_environ"
......
......@@ -413,6 +413,13 @@ readIO s = case (do { (x,t) <- reads s ;
[x] -> return x
[] -> ioError (userError "Prelude.readIO: no parse")
_ -> ioError (userError "Prelude.readIO: ambiguous parse")
-- | The Unicode encoding of the current locale
--
-- This is the initial locale encoding: if it has been subsequently changed by
-- 'GHC.IO.Encoding.setLocaleEncoding' this value will not reflect that change.
localeEncoding :: TextEncoding
localeEncoding = initLocaleEncoding
#endif /* __GLASGOW_HASKELL__ */
#ifndef __NHC__
......@@ -584,8 +591,8 @@ openTempFile' loc tmp_dir template binary mode = do
False{-is_socket-}
True{-is_nonblock-}
h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-}
(Just localeEncoding)
enc <- getLocaleEncoding
h <- mkHandleFromFD fD fd_type filepath ReadWriteMode False{-set non-block-} (Just enc)
return (filepath, h)
#else
......
......@@ -53,7 +53,7 @@ import GHC.IO.IOMode
import GHC.IO.Exception
import GHC.IO.Device
#ifndef mingw32_HOST_OS
import {-# SOURCE #-} GHC.IO.Encoding (fileSystemEncoding)
import {-# SOURCE #-} GHC.IO.Encoding (getFileSystemEncoding)
import qualified GHC.Foreign as GHC
#endif
#elif __HUGS__
......@@ -199,9 +199,9 @@ peekFilePath :: CString -> IO FilePath
peekFilePathLen :: CStringLen -> IO FilePath
#if __GLASGOW_HASKELL__
withFilePath = GHC.withCString fileSystemEncoding
peekFilePath = GHC.peekCString fileSystemEncoding
peekFilePathLen = GHC.peekCStringLen fileSystemEncoding
withFilePath fp f = getFileSystemEncoding >>= \enc -> GHC.withCString enc fp f
peekFilePath fp = getFileSystemEncoding >>= \enc -> GHC.peekCString enc fp
peekFilePathLen fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc fp
#else
withFilePath = withCString
peekFilePath = peekCString
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment