    {-# LANGUAGE BangPatterns #-}
    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)

    -- note CodePage = UInt which might not work on Win64.  But the Win32 package
    -- also has this issue.
    getCurrentCodePage :: IO Word32
    getCurrentCodePage = do
        conCP <- getConsoleCP
        if conCP > 0
            then return conCP
            else getACP

    -- Since the Win32 package depends on base, we have to import these ourselves:
    foreign import stdcall unsafe "windows.h GetConsoleCP"
        getConsoleCP :: IO Word32

    foreign import stdcall unsafe "windows.h GetACP"
        getACP :: IO Word32

    {-# NOINLINE localeEncoding #-}
    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)

    --------------------------------------------
    -- Array access functions

    -- {-# INLINE lookupConv #-}
    lookupConv :: ConvArray Char -> Word8 -> Char
    lookupConv a = indexChar a . fromEnum

    {-# INLINE lookupCompact #-}
    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

    {-# INLINE indexInt #-}
    indexInt :: ConvArray Int -> Int -> Int
    indexInt (ConvArray p) (I# i) = I# (indexInt16OffAddr# p i)

    {-# INLINE indexWord8 #-}
    indexWord8 :: ConvArray Word8 -> Int -> Word8
    indexWord8 (ConvArray p) (I# i) = W8# (indexWord8OffAddr# p i)

    {-# INLINE indexChar #-}
    indexChar :: ConvArray Char -> Int -> Char
    indexChar (ConvArray p) (I# i) = C# (chr# (indexInt16OffAddr# p i))

    #endif