Use explicit language extensions & remove extension fields from base.cabal

[ghc-base.git] / GHC / IO / Encoding / Iconv.hs

diff --git a/GHC/IO/Encoding/Iconv.hs b/GHC/IO/Encoding/Iconv.hs
index 237468a..0316698 100644 (file)
--- a/GHC/IO/Encoding/Iconv.hs
+++ b/GHC/IO/Encoding/Iconv.hs
@@ -1,4 +1,9 @@
-{-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
+{-# LANGUAGE CPP
+           , NoImplicitPrelude
+           , ForeignFunctionInterface
+           , NondecreasingIndentation
+  #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IO.Encoding.Iconv
@@ -25,42 +30,36 @@ 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
 
@@ -98,29 +97,37 @@ utf32be = unsafePerformIO (mkTextEncoding "UTF32BE")
 
 {-# 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
@@ -130,6 +137,7 @@ char_shift | charSize == 2 = 1
 mkTextEncoding :: String -> IO TextEncoding
 mkTextEncoding charset = do
   return (TextEncoding { 
+                textEncodingName = charset,
                mkTextDecoder = newIConv charset haskellChar iconvDecode,
                mkTextEncoder = newIConv haskellChar charset iconvEncode})
 
@@ -139,9 +147,8 @@ newIConv :: String -> String
 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,
@@ -164,6 +171,7 @@ iconvRecode iconv_t
   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
@@ -172,7 +180,7 @@ iconvRecode iconv_t
     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 
@@ -191,11 +199,10 @@ iconvRecode iconv_t
        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
@@ -208,8 +215,9 @@ iconvRecode iconv_t
                 -- 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 */