1 {-# LANGUAGE BangPatterns #-}
2 module GHC.IO.Encoding.CodePage(
3 #if !defined(mingw32_HOST_OS)
14 import GHC.IO (unsafePerformIO)
15 import GHC.IO.Encoding.Types
17 import GHC.IO.Exception
20 import Data.List (lookup)
22 import GHC.IO.Encoding.CodePage.Table
24 import GHC.IO.Encoding.Latin1 (latin1)
25 import GHC.IO.Encoding.UTF8 (utf8)
26 import GHC.IO.Encoding.UTF16 (utf16le, utf16be)
27 import GHC.IO.Encoding.UTF32 (utf32le, utf32be)
29 -- note CodePage = UInt which might not work on Win64. But the Win32 package
30 -- also has this issue.
31 getCurrentCodePage :: IO Word32
32 getCurrentCodePage = do
38 -- Since the Win32 package depends on base, we have to import these ourselves:
39 foreign import stdcall unsafe "windows.h GetConsoleCP"
40 getConsoleCP :: IO Word32
42 foreign import stdcall unsafe "windows.h GetACP"
45 {-# NOINLINE localeEncoding #-}
46 localeEncoding :: TextEncoding
47 localeEncoding = unsafePerformIO $ fmap codePageEncoding getCurrentCodePage
50 codePageEncoding :: Word32 -> TextEncoding
51 codePageEncoding 65001 = utf8
52 codePageEncoding 1200 = utf16le
53 codePageEncoding 1201 = utf16be
54 codePageEncoding 12000 = utf32le
55 codePageEncoding 12001 = utf32be
56 codePageEncoding cp = maybe latin1 buildEncoding (lookup cp codePageMap)
58 buildEncoding :: CodePageArrays -> TextEncoding
59 buildEncoding SingleByteCP {decoderArray = dec, encoderArray = enc}
61 mkTextDecoder = return $ simpleCodec
62 $ decodeFromSingleByte dec
63 , mkTextEncoder = return $ simpleCodec $ encodeToSingleByte enc
66 simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
67 -> BufferCodec from to ()
68 simpleCodec f = BufferCodec {encode = f, close = return (), getState = return (),
71 decodeFromSingleByte :: ConvArray Char -> DecodeBuffer
72 decodeFromSingleByte convArr
73 input@Buffer { bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
74 output@Buffer { bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
76 done !ir !ow = return (if ir==iw then input{ bufL=0, bufR=0}
80 | ow >= os || ir >= iw = done ir ow
82 b <- readWord8Buf iraw ir
83 let c = lookupConv convArr b
84 if c=='\0' && b /= 0 then invalid else do
85 ow' <- writeCharBuf oraw ow c
88 invalid = if ir > ir0 then done ir ow else ioe_decodingError
91 encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer
92 encodeToSingleByte CompactArray { encoderMax = maxChar,
93 encoderIndices = indices,
94 encoderValues = values }
95 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
96 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
98 done !ir !ow = return (if ir==iw then input { bufL=0, bufR=0 }
99 else input { bufL=ir },
102 | ow >= os || ir >= iw = done ir ow
104 (c,ir') <- readCharBuf iraw ir
105 case lookupCompact maxChar indices values c of
107 Just 0 | c /= '\0' -> invalid
109 writeWord8Buf oraw ow b
112 invalid = if ir > ir0 then done ir ow else ioe_encodingError
116 ioe_decodingError :: IO a
117 ioe_decodingError = ioException
118 (IOError Nothing InvalidArgument "codePageEncoding"
119 "invalid code page byte sequence" Nothing Nothing)
121 ioe_encodingError :: IO a
122 ioe_encodingError = ioException
123 (IOError Nothing InvalidArgument "codePageEncoding"
124 "character is not in the code page" Nothing Nothing)
127 --------------------------------------------
128 -- Array access functions
130 -- {-# INLINE lookupConv #-}
131 lookupConv :: ConvArray Char -> Word8 -> Char
132 lookupConv a = indexChar a . fromEnum
134 {-# INLINE lookupCompact #-}
135 lookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8
136 lookupCompact maxVal indexes values x
137 | x > maxVal = Nothing
138 | otherwise = Just $ indexWord8 values $ j + (i .&. mask)
141 mask = (1 `shiftL` n) - 1
143 j = indexInt indexes k
146 {-# INLINE indexInt #-}
147 indexInt :: ConvArray Int -> Int -> Int
148 indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)
150 {-# INLINE indexWord8 #-}
151 indexWord8 :: ConvArray Word8 -> Int -> Word8
152 indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)
154 {-# INLINE indexChar #-}
155 indexChar :: ConvArray Char -> Int -> Char
156 indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))