-{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.Encoding.Iconv
#endif
) where
-#if !defined(mingw32_HOST_OS)
+#include "MachDeps.h"
+#include "HsBaseConfig.h"
-#undef DEBUG_DUMP
+#if !defined(mingw32_HOST_OS)
-import Foreign
+import Foreign hiding (unsafePerformIO)
import Foreign.C
import Data.Maybe
import GHC.Base
-import GHC.Word
-import GHC.IO
import GHC.IO.Buffer
import GHC.IO.Encoding.Types
import GHC.Num
import GHC.Show
import GHC.Real
-#ifdef DEBUG_DUMP
+import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Internals
-#endif
-iconv_trace :: String -> IO ()
-
-#ifdef DEBUG_DUMP
+c_DEBUG_DUMP :: Bool
+c_DEBUG_DUMP = False
-iconv_trace s = puts s
+iconv_trace :: String -> IO ()
+iconv_trace s
+ | c_DEBUG_DUMP = puts s
+ | otherwise = return ()
puts :: String -> IO ()
-puts s = do withCStringLen (s++"\n") $ \(p,len) ->
- c_write 1 p (fromIntegral len)
+puts s = do _ <- withCStringLen (s ++ "\n") $ \(p, len) ->
+ c_write 1 (castPtr p) (fromIntegral len)
return ()
-#else
-
-iconv_trace _ = return ()
-
-#endif
-
-- -----------------------------------------------------------------------------
-- iconv encoders/decoders
{-# NOINLINE localeEncoding #-}
localeEncoding :: TextEncoding
-localeEncoding = unsafePerformIO (mkTextEncoding "")
+localeEncoding = unsafePerformIO $ do
+ -- Use locale_charset() or nl_langinfo(CODESET) to get the encoding
+ -- if we have either of them.
+ cstr <- c_localeEncoding
+ r <- peekCString cstr
+ mkTextEncoding r
-- We hope iconv_t is a storable type. It should be, since it has at least the
-- value -1, which is a possible return value from iconv_open.
type IConv = CLong -- ToDo: (#type iconv_t)
-foreign import ccall unsafe "iconv_open"
- iconv_open :: CString -> CString -> IO IConv
+foreign import ccall unsafe "hs_iconv_open"
+ hs_iconv_open :: CString -> CString -> IO IConv
-foreign import ccall unsafe "iconv_close"
- iconv_close :: IConv -> IO CInt
+foreign import ccall unsafe "hs_iconv_close"
+ hs_iconv_close :: IConv -> IO CInt
-foreign import ccall unsafe "iconv"
- iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize
+foreign import ccall unsafe "hs_iconv"
+ hs_iconv :: IConv -> Ptr CString -> Ptr CSize -> Ptr CString -> Ptr CSize
-> IO CSize
+foreign import ccall unsafe "localeEncoding"
+ c_localeEncoding :: IO CString
+
haskellChar :: String
#ifdef WORDS_BIGENDIAN
-haskellChar | charSize == 2 = "UTF16BE"
- | otherwise = "UCS-4"
+haskellChar | charSize == 2 = "UTF-16BE"
+ | otherwise = "UTF-32BE"
#else
-haskellChar | charSize == 2 = "UTF16LE"
- | otherwise = "UCS-4LE"
+haskellChar | charSize == 2 = "UTF-16LE"
+ | otherwise = "UTF-32LE"
#endif
char_shift :: Int
mkTextEncoding :: String -> IO TextEncoding
mkTextEncoding charset = do
return (TextEncoding {
+ textEncodingName = charset,
mkTextDecoder = newIConv charset haskellChar iconvDecode,
mkTextEncoder = newIConv haskellChar charset iconvEncode})
newIConv :: String -> String
-> (IConv -> Buffer a -> Buffer b -> IO (Buffer a, Buffer b))
- -> IO (BufferCodec a b)
+ -> IO (BufferCodec a b ())
newIConv from to fn =
withCString from $ \ from_str ->
withCString to $ \ to_str -> do
- iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ iconv_open to_str from_str
- let iclose = do throwErrnoIfMinus1 "Iconv.close" $ iconv_close iconvt
- return ()
+ iconvt <- throwErrnoIfMinus1 "mkTextEncoding" $ hs_iconv_open to_str from_str
+ let iclose = throwErrnoIfMinus1_ "Iconv.close" $ hs_iconv_close iconvt
return BufferCodec{
encode = fn iconvt,
- close = iclose
+ close = iclose,
+ -- iconv doesn't supply a way to save/restore the state
+ getState = return (),
+ setState = const $ return ()
}
iconvDecode :: IConv -> Buffer Word8 -> Buffer CharBufElem
input@Buffer{ bufRaw=iraw, bufL=ir, bufR=iw, bufSize=_ } iscale
output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow, bufSize=os } oscale
= do
+ iconv_trace ("haskelChar=" ++ show haskellChar)
iconv_trace ("iconvRecode before, input=" ++ show (summaryBuffer input))
iconv_trace ("iconvRecode before, output=" ++ show (summaryBuffer output))
withRawBuffer iraw $ \ piraw -> do
with (poraw `plusPtr` (ow `shiftL` oscale)) $ \ p_outbuf -> do
with (fromIntegral ((iw-ir) `shiftL` iscale)) $ \ p_inleft -> do
with (fromIntegral ((os-ow) `shiftL` oscale)) $ \ p_outleft -> do
- res <- iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft
+ res <- hs_iconv iconv_t p_inbuf p_inleft p_outbuf p_outleft
new_inleft <- peek p_inleft
new_outleft <- peek p_outleft
let
else do
errno <- getErrno
case errno of
- e | e == eINVAL
- || (e == e2BIG || e == eILSEQ) && new_inleft' /= (iw-ir) -> do
+ e | e == eINVAL || e == e2BIG
+ || e == eILSEQ && new_inleft' /= (iw-ir) -> do
iconv_trace ("iconv ignoring error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))
- -- Output overflow is relatively harmless, unless
- -- we made no progress at all.
+ -- Output overflow is harmless
--
-- Similarly, we ignore EILSEQ unless we converted no
-- characters. Sometimes iconv reports EILSEQ for a
-- the buffer have been drained.
return (new_input, new_output)
- _other ->
- throwErrno "iconvRecoder"
+ e -> do
+ iconv_trace ("iconv returned error: " ++ show (errnoToIOError "iconv" e Nothing Nothing))
+ throwErrno "iconvRecoder"
-- illegal sequence, or some other error
#endif /* !mingw32_HOST_OS */