module GHC.IO.Encoding.CodePage(
#if !defined(mingw32_HOST_OS)
) where
#else
codePageEncoding,
localeEncoding
) where
import GHC.Base
import GHC.Show
import GHC.Num
import GHC.Enum
import GHC.Word
import GHC.IO (unsafePerformIO)
import GHC.IO.Encoding.Types
import GHC.IO.Buffer
import GHC.IO.Exception
import Data.Bits
import Data.Maybe
import Data.List (lookup)
import GHC.IO.Encoding.CodePage.Table
import GHC.IO.Encoding.Latin1 (latin1)
import GHC.IO.Encoding.UTF8 (utf8)
import GHC.IO.Encoding.UTF16 (utf16le, utf16be)
import GHC.IO.Encoding.UTF32 (utf32le, utf32be)
getCurrentCodePage :: IO Word32
getCurrentCodePage = do
conCP <- getConsoleCP
if conCP > 0
then return conCP
else getACP
foreign import stdcall unsafe "windows.h GetConsoleCP"
getConsoleCP :: IO Word32
foreign import stdcall unsafe "windows.h GetACP"
getACP :: IO Word32
localeEncoding :: TextEncoding
localeEncoding = unsafePerformIO $ fmap codePageEncoding getCurrentCodePage
codePageEncoding :: Word32 -> TextEncoding
codePageEncoding 65001 = utf8
codePageEncoding 1200 = utf16le
codePageEncoding 1201 = utf16be
codePageEncoding 12000 = utf32le
codePageEncoding 12001 = utf32be
codePageEncoding cp = maybe latin1 (buildEncoding cp) (lookup cp codePageMap)
buildEncoding :: Word32 -> CodePageArrays -> TextEncoding
buildEncoding cp SingleByteCP {decoderArray = dec, encoderArray = enc}
= TextEncoding {
textEncodingName = "CP" ++ show cp,
mkTextDecoder = return $ simpleCodec
$ decodeFromSingleByte dec
, mkTextEncoder = return $ simpleCodec $ encodeToSingleByte enc
}
simpleCodec :: (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> BufferCodec from to ()
simpleCodec f = BufferCodec {encode = f, close = return (), getState = return (),
setState = return }
decodeFromSingleByte :: ConvArray Char -> DecodeBuffer
decodeFromSingleByte convArr
input@Buffer { bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output@Buffer { bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
= let
done !ir !ow = return (if ir==iw then input{ bufL=0, bufR=0}
else input{ bufL=ir},
output {bufR=ow})
loop !ir !ow
| ow >= os || ir >= iw = done ir ow
| otherwise = do
b <- readWord8Buf iraw ir
let c = lookupConv convArr b
if c=='\0' && b /= 0 then invalid else do
ow' <- writeCharBuf oraw ow c
loop (ir+1) ow'
where
invalid = if ir > ir0 then done ir ow else ioe_decodingError
in loop ir0 ow0
encodeToSingleByte :: CompactArray Char Word8 -> EncodeBuffer
encodeToSingleByte CompactArray { encoderMax = maxChar,
encoderIndices = indices,
encoderValues = values }
input@Buffer{ bufRaw=iraw, bufL=ir0, bufR=iw, bufSize=_ }
output@Buffer{ bufRaw=oraw, bufL=_, bufR=ow0, bufSize=os }
= let
done !ir !ow = return (if ir==iw then input { bufL=0, bufR=0 }
else input { bufL=ir },
output {bufR=ow})
loop !ir !ow
| ow >= os || ir >= iw = done ir ow
| otherwise = do
(c,ir') <- readCharBuf iraw ir
case lookupCompact maxChar indices values c of
Nothing -> invalid
Just 0 | c /= '\0' -> invalid
Just b -> do
writeWord8Buf oraw ow b
loop ir' (ow+1)
where
invalid = if ir > ir0 then done ir ow else ioe_encodingError
in
loop ir0 ow0
ioe_decodingError :: IO a
ioe_decodingError = ioException
(IOError Nothing InvalidArgument "codePageEncoding"
"invalid code page byte sequence" Nothing Nothing)
ioe_encodingError :: IO a
ioe_encodingError = ioException
(IOError Nothing InvalidArgument "codePageEncoding"
"character is not in the code page" Nothing Nothing)
lookupConv :: ConvArray Char -> Word8 -> Char
lookupConv a = indexChar a . fromEnum
lookupCompact :: Char -> ConvArray Int -> ConvArray Word8 -> Char -> Maybe Word8
lookupCompact maxVal indexes values x
| x > maxVal = Nothing
| otherwise = Just $ indexWord8 values $ j + (i .&. mask)
where
i = fromEnum x
mask = (1 `shiftL` n) 1
k = i `shiftR` n
j = indexInt indexes k
n = blockBitSize
indexInt :: ConvArray Int -> Int -> Int
indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)
indexWord8 :: ConvArray Word8 -> Int -> Word8
indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)
indexChar :: ConvArray Char -> Int -> Char
indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))
#endif