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 cp) (lookup cp codePageMap)
58 buildEncoding :: Word32 -> CodePageArrays -> TextEncoding
59 buildEncoding cp SingleByteCP {decoderArray = dec, encoderArray = enc}
61 textEncodingName = "CP" ++ show cp,
62 mkTextDecoder = return $ simpleCodec
63 $ decodeFromSingleByte dec
64 , mkTextEncoder = return $ simpleCodec $ encodeToSingleByte enc
67 simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
68 -> BufferCodec from to ()
69 simpleCodec f = BufferCodec {encode = f, close = return (), getState = return (),
72 decodeFromSingleByte :: ConvArray Char -> DecodeBuffer
73 decodeFromSingleByte convArr
74 input@Buffer { bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
75 output@Buffer { bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
77 done !ir !ow = return (if ir==iw then input{ bufL=0, bufR=0}
81 | ow >= os || ir >= iw = done ir ow
83 b <- readWord8Buf iraw ir
84 let c = lookupConv convArr b
85 if c=='\0' && b /= 0 then invalid else do
86 ow' <- writeCharBuf oraw ow c
89 invalid = if ir > ir0 then done ir ow else ioe_decodingError
92 encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer
93 encodeToSingleByte CompactArray { encoderMax = maxChar,
94 encoderIndices = indices,
95 encoderValues = values }
96 input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
97 output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
99 done !ir !ow = return (if ir==iw then input { bufL=0, bufR=0 }
100 else input { bufL=ir },
103 | ow >= os || ir >= iw = done ir ow
105 (c,ir') <- readCharBuf iraw ir
106 case lookupCompact maxChar indices values c of
108 Just 0 | c /= '\0' -> invalid
110 writeWord8Buf oraw ow b
113 invalid = if ir > ir0 then done ir ow else ioe_encodingError
117 ioe_decodingError :: IO a
118 ioe_decodingError = ioException
119 (IOError Nothing InvalidArgument "codePageEncoding"
120 "invalid code page byte sequence" Nothing Nothing)
122 ioe_encodingError :: IO a
123 ioe_encodingError = ioException
124 (IOError Nothing InvalidArgument "codePageEncoding"
125 "character is not in the code page" Nothing Nothing)
128 --------------------------------------------
129 -- Array access functions
131 -- {-# INLINE lookupConv #-}
132 lookupConv :: ConvArray Char -> Word8 -> Char
133 lookupConv a = indexChar a . fromEnum
135 {-# INLINE lookupCompact #-}
136 lookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8
137 lookupCompact maxVal indexes values x
138 | x > maxVal = Nothing
139 | otherwise = Just $ indexWord8 values $ j + (i .&. mask)
142 mask = (1 `shiftL` n) - 1
144 j = indexInt indexes k
147 {-# INLINE indexInt #-}
148 indexInt :: ConvArray Int -> Int -> Int
149 indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)
151 {-# INLINE indexWord8 #-}
152 indexWord8 :: ConvArray Word8 -> Int -> Word8
153 indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)
155 {-# INLINE indexChar #-}
156 indexChar :: ConvArray Char -> Int -> Char
157 indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))