    {-# LANGUAGE NoImplicitPrelude
               , BangPatterns
               , TypeApplications
               , MultiWayIf
      #-}
    {-# OPTIONS_GHC  -funbox-strict-fields #-}

    module System.OsString.Encoding.Internal where

    import qualified System.OsString.Data.ByteString.Short as BS8
    import qualified System.OsString.Data.ByteString.Short.Word16 as BS16

    import GHC.Base
    import GHC.Real
    import GHC.Num
    -- import GHC.IO
    import GHC.IO.Buffer
    import GHC.IO.Encoding.Failure
    import GHC.IO.Encoding.Types
    import Data.Bits
    import Control.Exception (SomeException, try, Exception (displayException), evaluate)
    import qualified GHC.Foreign as GHC
    import Data.Either (Either)
    import GHC.IO (unsafePerformIO)
    import Control.DeepSeq (force, NFData (rnf))
    import Data.Bifunctor (first)
    import Data.Data (Typeable)
    import GHC.Show (Show (show))
    import Numeric (showHex)
    import Foreign.C (CStringLen)
    import Data.Char (chr)
    import Foreign
    import GHC.IO.Encoding (getFileSystemEncoding)

    -- -----------------------------------------------------------------------------
    -- UCS-2 LE
    --

    ucs2le :: TextEncoding
    ucs2le :: TextEncoding
    ucs2le = CodingFailureMode -> TextEncoding
    mkUcs2le CodingFailureMode
    ErrorOnCodingFailure

    mkUcs2le :: CodingFailureMode -> TextEncoding
    mkUcs2le :: CodingFailureMode -> TextEncoding
    mkUcs2le CodingFailureMode
    cfm = TextEncoding { textEncodingName :: String
    textEncodingName = String
    "UCS-2LE",
                                  mkTextDecoder :: IO (TextDecoder ())
    mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
    ucs2le_DF CodingFailureMode
    cfm,
                                  mkTextEncoder :: IO (TextEncoder ())
    mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
    ucs2le_EF CodingFailureMode
    cfm }

    ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ())
    ucs2le_DF :: CodingFailureMode -> IO (TextDecoder ())
    ucs2le_DF CodingFailureMode
    cfm =
      TextDecoder () -> IO (TextDecoder ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BufferCodec {
                 encode :: CodeBuffer Word8 Char
    encode   = CodeBuffer Word8 Char
    ucs2le_decode,
                 recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
    recover  = CodingFailureMode
    -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
    recoverDecode CodingFailureMode
    cfm,
                 close :: IO ()
    close    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 getState :: IO ()
    getState = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 setState :: () -> IO ()
    setState = IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              })

    ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ())
    ucs2le_EF :: CodingFailureMode -> IO (TextEncoder ())
    ucs2le_EF CodingFailureMode
    cfm =
      TextEncoder () -> IO (TextEncoder ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BufferCodec {
                 encode :: CodeBuffer Char Word8
    encode   = CodeBuffer Char Word8
    ucs2le_encode,
                 recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
    recover  = CodingFailureMode
    -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
    recoverEncode CodingFailureMode
    cfm,
                 close :: IO ()
    close    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 getState :: IO ()
    getState = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 setState :: () -> IO ()
    setState = IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              })

    ucs2le_decode :: DecodeBuffer
    ucs2le_decode :: CodeBuffer Word8 Char
    ucs2le_decode
      input :: Buffer Word8
    input@Buffer{  bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Word8
    iraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    ir0, bufR :: forall e. Buffer e -> Int
    bufR=Int
    iw,  bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    _  }
      output :: Buffer Char
    output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    oraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    _,   bufR :: forall e. Buffer e -> Int
    bufR=Int
    ow0, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    os }
     = let
           loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    loop !Int
    ir !Int
    ow
             | Int
    ow Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    os     = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    OutputUnderflow Int
    ir Int
    ow
             | Int
    ir Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    iw     = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
             | Int
    ir Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
             | Bool
    otherwise = do
                  c0 <- RawBuffer Word8 -> Int -> IO Word8
    readWord8Buf RawBuffer Word8
    iraw Int
    ir
                  c1 <- readWord8Buf iraw (ir+1)
                  let x1 = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c0
                  ow' <- writeCharBuf oraw ow (unsafeChr x1)
                  loop (ir+2) ow'

           -- lambda-lifted, to avoid thunks being built in the inner-loop:
           done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done a
    why !Int
    ir !Int
    ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    why,
                                      if Int
    ir Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw then Buffer Word8
    input{ bufL=0, bufR=0 }
                                                  else Buffer Word8
    input{ bufL=ir },
                                      Buffer Char
    output{ bufR=ow })
        in
        Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    loop Int
    ir0 Int
    ow0

    ucs2le_encode :: EncodeBuffer
    ucs2le_encode :: CodeBuffer Char Word8
    ucs2le_encode
      input :: Buffer Char
    input@Buffer{  bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    iraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    ir0, bufR :: forall e. Buffer e -> Int
    bufR=Int
    iw,  bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    _  }
      output :: Buffer Word8
    output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Word8
    oraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    _,   bufR :: forall e. Buffer e -> Int
    bufR=Int
    ow0, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    os }
     = let
          done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done a
    why !Int
    ir !Int
    ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    why,
                                     if Int
    ir Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw then Buffer Char
    input{ bufL=0, bufR=0 }
                                                 else Buffer Char
    input{ bufL=ir },
                                     Buffer Word8
    output{ bufR=ow })
          loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop !Int
    ir !Int
    ow
            | Int
    ir Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    iw     =  CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
            | Int
    os Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ow Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2  =  CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    OutputUnderflow Int
    ir Int
    ow
            | Bool
    otherwise = do
               (c,ir') <- RawBuffer Char -> Int -> IO (Char, Int)
    readCharBuf RawBuffer Char
    iraw Int
    ir
               case ord c of
                 Int
    x | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0x10000 -> do
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw Int
    ow     (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    x)
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    x Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8))
                         Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop Int
    ir' (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2)
                   | Bool
    otherwise -> CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    InvalidSequence Int
    ir Int
    ow
        in
        Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop Int
    ir0 Int
    ow0

    -- -----------------------------------------------------------------------------
    -- UTF-16b
    --

    -- | Mimics the base encoding for filesystem operations. This should be total on all inputs (word16 byte arrays).
    --
    -- Note that this has a subtle difference to 'encodeWithBaseWindows'/'decodeWithBaseWindows': it doesn't care for
    -- the @0x0000@ end marker and will as such produce different results. Use @takeWhile (/= '\NUL')@ on the input
    -- to recover this behavior.
    utf16le_b :: TextEncoding
    utf16le_b :: TextEncoding
    utf16le_b = CodingFailureMode -> TextEncoding
    mkUTF16le_b CodingFailureMode
    ErrorOnCodingFailure

    mkUTF16le_b :: CodingFailureMode -> TextEncoding
    mkUTF16le_b :: CodingFailureMode -> TextEncoding
    mkUTF16le_b CodingFailureMode
    cfm = TextEncoding { textEncodingName :: String
    textEncodingName = String
    "UTF-16LE_b",
                                     mkTextDecoder :: IO (TextDecoder ())
    mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
    utf16le_b_DF CodingFailureMode
    cfm,
                                     mkTextEncoder :: IO (TextEncoder ())
    mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
    utf16le_b_EF CodingFailureMode
    cfm }

    utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ())
    utf16le_b_DF :: CodingFailureMode -> IO (TextDecoder ())
    utf16le_b_DF CodingFailureMode
    cfm =
      TextDecoder () -> IO (TextDecoder ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BufferCodec {
                 encode :: CodeBuffer Word8 Char
    encode   = CodeBuffer Word8 Char
    utf16le_b_decode,
                 recover :: Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
    recover  = CodingFailureMode
    -> Buffer Word8 -> Buffer Char -> IO (Buffer Word8, Buffer Char)
    recoverDecode CodingFailureMode
    cfm,
                 close :: IO ()
    close    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 getState :: IO ()
    getState = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 setState :: () -> IO ()
    setState = IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              })

    utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ())
    utf16le_b_EF :: CodingFailureMode -> IO (TextEncoder ())
    utf16le_b_EF CodingFailureMode
    cfm =
      TextEncoder () -> IO (TextEncoder ())
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (BufferCodec {
                 encode :: CodeBuffer Char Word8
    encode   = CodeBuffer Char Word8
    utf16le_b_encode,
                 recover :: Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
    recover  = CodingFailureMode
    -> Buffer Char -> Buffer Word8 -> IO (Buffer Char, Buffer Word8)
    recoverEncode CodingFailureMode
    cfm,
                 close :: IO ()
    close    = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 getState :: IO ()
    getState = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (),
                 setState :: () -> IO ()
    setState = IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              })

    utf16le_b_decode :: DecodeBuffer
    utf16le_b_decode :: CodeBuffer Word8 Char
    utf16le_b_decode
      input :: Buffer Word8
    input@Buffer{  bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Word8
    iraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    ir0, bufR :: forall e. Buffer e -> Int
    bufR=Int
    iw,  bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    _  }
      output :: Buffer Char
    output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    oraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    _,   bufR :: forall e. Buffer e -> Int
    bufR=Int
    ow0, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    os }
     = let
           loop :: Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    loop !Int
    ir !Int
    ow
             | Int
    ow Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    os     = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    OutputUnderflow Int
    ir Int
    ow
             | Int
    ir Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    iw     = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
             | Int
    ir Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw = CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
             | Bool
    otherwise = do
                  c0 <- RawBuffer Word8 -> Int -> IO Word8
    readWord8Buf RawBuffer Word8
    iraw Int
    ir
                  c1 <- readWord8Buf iraw (ir+1)
                  let x1 = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c0
                  if | iw - ir >= 4 -> do
                          c2 <- readWord8Buf iraw (ir+2)
                          c3 <- readWord8Buf iraw (ir+3)
                          let x2 = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c3 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c2
                          if | 0xd800 <= x1 && x1 <= 0xdbff
                             , 0xdc00 <= x2 && x2 <= 0xdfff -> do
                                 ow' <- writeCharBuf oraw ow (unsafeChr ((x1 - 0xd800)*0x400 + (x2 - 0xdc00) + 0x10000))
                                 loop (ir+4) ow'
                             | otherwise -> do
                                 ow' <- writeCharBuf oraw ow (unsafeChr x1)
                                 loop (ir+2) ow'
                     | iw - ir >= 2 -> do
                            ow' <- writeCharBuf oraw ow (unsafeChr x1)
                            loop (ir+2) ow'
                     | otherwise -> done InputUnderflow ir ow

           -- lambda-lifted, to avoid thunks being built in the inner-loop:
           done :: a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
    done a
    why !Int
    ir !Int
    ow = (a, Buffer Word8, Buffer Char) -> m (a, Buffer Word8, Buffer Char)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    why,
                                      if Int
    ir Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw then Buffer Word8
    input{ bufL=0, bufR=0 }
                                                  else Buffer Word8
    input{ bufL=ir },
                                      Buffer Char
    output{ bufR=ow })
        in
        Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
    loop Int
    ir0 Int
    ow0

    utf16le_b_encode :: EncodeBuffer
    utf16le_b_encode :: CodeBuffer Char Word8
    utf16le_b_encode
      input :: Buffer Char
    input@Buffer{  bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Char
    iraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    ir0, bufR :: forall e. Buffer e -> Int
    bufR=Int
    iw,  bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    _  }
      output :: Buffer Word8
    output@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e
    bufRaw=RawBuffer Word8
    oraw, bufL :: forall e. Buffer e -> Int
    bufL=Int
    _,   bufR :: forall e. Buffer e -> Int
    bufR=Int
    ow0, bufSize :: forall e. Buffer e -> Int
    bufSize=Int
    os }
     = let
          done :: a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done a
    why !Int
    ir !Int
    ow = (a, Buffer Char, Buffer Word8) -> m (a, Buffer Char, Buffer Word8)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    why,
                                     if Int
    ir Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    iw then Buffer Char
    input{ bufL=0, bufR=0 }
                                                 else Buffer Char
    input{ bufL=ir },
                                     Buffer Word8
    output{ bufR=ow })
          loop :: Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop !Int
    ir !Int
    ow
            | Int
    ir Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    iw     =  CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    InputUnderflow Int
    ir Int
    ow
            | Int
    os Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ow Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2  =  CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    OutputUnderflow Int
    ir Int
    ow
            | Bool
    otherwise = do
               (c,ir') <- RawBuffer Char -> Int -> IO (Char, Int)
    readCharBuf RawBuffer Char
    iraw Int
    ir
               case ord c of
                 Int
    x | Int
    x Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0x10000 -> do
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw Int
    ow     (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    x)
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    x Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8))
                         Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop Int
    ir' (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2)
                   | Bool
    otherwise ->
                         if Int
    os Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    ow Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    4 then CodingProgress
    -> Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    forall {m :: * -> *} {a}.
    Monad m =>
    a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
    done CodingProgress
    OutputUnderflow Int
    ir Int
    ow else do
                         let x' :: Int
    x' = Int
    x Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    0x10000
                             w1 :: Int
    w1 = Int
    x' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    0x400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0xd800
                             w2 :: Int
    w2 = Int
    x' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    0x400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0xdc00
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw Int
    ow     (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    w1)
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    w1 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8))
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    2) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    w2)
                         RawBuffer Word8 -> Int -> Word8 -> IO ()
    writeWord8Buf RawBuffer Word8
    oraw (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    3) (Int -> Word8
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    w2 Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftR` Int
    8))
                         Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop Int
    ir' (Int
    owInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4)
        in
        Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
    loop Int
    ir0 Int
    ow0

    -- -----------------------------------------------------------------------------
    -- Windows encoding (ripped off from base)
    --

    cWcharsToChars_UCS2 :: [Word16] -> [Char]
    cWcharsToChars_UCS2 :: [Word16] -> String
    cWcharsToChars_UCS2 = (Word16 -> Char) -> [Word16] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> Char
    chr (Int -> Char) -> (Word16 -> Int) -> Word16 -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral)

    -- On Windows, wchar_t is 16 bits wide and CWString uses the UTF-16 encoding.

    -- coding errors generate Chars in the surrogate range
    cWcharsToChars :: [Word16] -> [Char]
    cWcharsToChars :: [Word16] -> String
    cWcharsToChars = (Int -> Char) -> [Int] -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    chr ([Int] -> String) -> ([Word16] -> [Int]) -> [Word16] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Int] -> [Int]
    fromUTF16 ([Int] -> [Int]) -> ([Word16] -> [Int]) -> [Word16] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Word16 -> Int) -> [Word16] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map Word16 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral
     where
      fromUTF16 :: [Int] -> [Int]
      fromUTF16 :: [Int] -> [Int]
    fromUTF16 (Int
    c1:Int
    c2:[Int]
    wcs)
        | Int
    0xd800 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c1 Bool -> Bool -> Bool
    && Int
    c1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0xdbff Bool -> Bool -> Bool
    && Int
    0xdc00 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    c2 Bool -> Bool -> Bool
    && Int
    c2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0xdfff =
          ((Int
    c1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    0xd800)Int -> Int -> Int
    forall a. Num a => a -> a -> a
    *Int
    0x400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    c2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    0xdc00) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0x10000) Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int] -> [Int]
    fromUTF16 [Int]
    wcs
      fromUTF16 (Int
    c:[Int]
    wcs) = Int
    c Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    : [Int] -> [Int]
    fromUTF16 [Int]
    wcs
      fromUTF16 [] = []

    charsToCWchars :: [Char] -> [Word16]
    charsToCWchars :: String -> [Word16]
    charsToCWchars = (Char -> [Word16] -> [Word16]) -> [Word16] -> String -> [Word16]
    forall a b. (a -> b -> b) -> b -> [a] -> b
    foldr (Int -> [Word16] -> [Word16]
    utf16Char (Int -> [Word16] -> [Word16])
    -> (Char -> Int) -> Char -> [Word16] -> [Word16]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Int
    ord) []
     where
      utf16Char :: Int -> [Word16] -> [Word16]
      utf16Char :: Int -> [Word16] -> [Word16]
    utf16Char Int
    c [Word16]
    wcs
        | Int
    c Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0x10000 = Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    c Word16 -> [Word16] -> [Word16]
    forall a. a -> [a] -> [a]
    : [Word16]
    wcs
        | Bool
    otherwise   = let c' :: Int
    c' = Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    0x10000 in
                        Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    c' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    0x400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0xd800) Word16 -> [Word16] -> [Word16]
    forall a. a -> [a] -> [a]
    :
                        Int -> Word16
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    c' Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    0x400 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    0xdc00) Word16 -> [Word16] -> [Word16]
    forall a. a -> [a] -> [a]
    : [Word16]
    wcs

    -- -----------------------------------------------------------------------------

    -- -----------------------------------------------------------------------------
    -- FFI
    --

    withWindowsString :: String -> (Int -> Ptr Word16 -> IO a) -> IO a
    withWindowsString :: forall a. String -> (Int -> Ptr Word16 -> IO a) -> IO a
    withWindowsString = [Word16] -> (Int -> Ptr Word16 -> IO a) -> IO a
    forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
    withArrayLen ([Word16] -> (Int -> Ptr Word16 -> IO a) -> IO a)
    -> (String -> [Word16])
    -> String
    -> (Int -> Ptr Word16 -> IO a)
    -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [Word16]
    charsToCWchars

    peekWindowsString :: (Ptr Word16, Int) -> IO String
    peekWindowsString :: (Ptr Word16, Int) -> IO String
    peekWindowsString (Ptr Word16
    cp, Int
    l) = do
      cs <- Int -> Ptr Word16 -> IO [Word16]
    forall a. Storable a => Int -> Ptr a -> IO [a]
    peekArray Int
    l Ptr Word16
    cp
      return (cWcharsToChars cs)

    withPosixString :: String -> (CStringLen -> IO a) -> IO a
    withPosixString :: forall a. String -> (CStringLen -> IO a) -> IO a
    withPosixString String
    fp CStringLen -> IO a
    f = IO TextEncoding
    getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TextEncoding
    enc -> TextEncoding -> String -> (CStringLen -> IO a) -> IO a
    forall a. TextEncoding -> String -> (CStringLen -> IO a) -> IO a
    GHC.withCStringLen TextEncoding
    enc String
    fp CStringLen -> IO a
    f

    peekPosixString :: CStringLen -> IO String
    peekPosixString :: CStringLen -> IO String
    peekPosixString CStringLen
    fp = IO TextEncoding
    getFileSystemEncoding IO TextEncoding -> (TextEncoding -> IO String) -> IO String
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TextEncoding
    enc -> TextEncoding -> CStringLen -> IO String
    GHC.peekCStringLen TextEncoding
    enc CStringLen
    fp

    -- | Decode with the given 'TextEncoding'.
    decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String
    decodeWithTE :: TextEncoding -> ShortByteString -> Either EncodingException String
    decodeWithTE TextEncoding
    enc ShortByteString
    ba = IO (Either EncodingException String)
    -> Either EncodingException String
    forall a. IO a -> a
    unsafePerformIO (IO (Either EncodingException String)
     -> Either EncodingException String)
    -> IO (Either EncodingException String)
    -> Either EncodingException String
    forall a b. (a -> b) -> a -> b
    $ do
      r <- forall e a. Exception e => IO a -> IO (Either e a)
    try @SomeException (IO String -> IO (Either SomeException String))
    -> IO String -> IO (Either SomeException String)
    forall a b. (a -> b) -> a -> b
    $ ShortByteString -> (CStringLen -> IO String) -> IO String
    forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
    BS8.useAsCStringLen ShortByteString
    ba ((CStringLen -> IO String) -> IO String)
    -> (CStringLen -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \CStringLen
    fp -> TextEncoding -> CStringLen -> IO String
    GHC.peekCStringLen TextEncoding
    enc CStringLen
    fp
      evaluate $ force $ first (flip EncodingError Nothing . displayException) r

    -- | Encode with the given 'TextEncoding'.
    encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString
    encodeWithTE :: TextEncoding -> String -> Either EncodingException ShortByteString
    encodeWithTE TextEncoding
    enc String
    str = IO (Either EncodingException ShortByteString)
    -> Either EncodingException ShortByteString
    forall a. IO a -> a
    unsafePerformIO (IO (Either EncodingException ShortByteString)
     -> Either EncodingException ShortByteString)
    -> IO (Either EncodingException ShortByteString)
    -> Either EncodingException ShortByteString
    forall a b. (a -> b) -> a -> b
    $ do
      r <- forall e a. Exception e => IO a -> IO (Either e a)
    try @SomeException (IO ShortByteString -> IO (Either SomeException ShortByteString))
    -> IO ShortByteString -> IO (Either SomeException ShortByteString)
    forall a b. (a -> b) -> a -> b
    $ TextEncoding
    -> String
    -> (CStringLen -> IO ShortByteString)
    -> IO ShortByteString
    forall a. TextEncoding -> String -> (CStringLen -> IO a) -> IO a
    GHC.withCStringLen TextEncoding
    enc String
    str ((CStringLen -> IO ShortByteString) -> IO ShortByteString)
    -> (CStringLen -> IO ShortByteString) -> IO ShortByteString
    forall a b. (a -> b) -> a -> b
    $ \CStringLen
    cstr -> CStringLen -> IO ShortByteString
    BS8.packCStringLen CStringLen
    cstr
      evaluate $ force $ first (flip EncodingError Nothing . displayException) r

    -- -----------------------------------------------------------------------------
    -- Encoders / decoders
    --

    -- | This mimics the filepath decoder base uses on unix,
    -- with the small distinction that we're not truncating at NUL bytes (because we're not at
    -- the outer FFI layer).
    decodeWithBasePosix :: BS8.ShortByteString -> IO String
    decodeWithBasePosix :: ShortByteString -> IO String
    decodeWithBasePosix ShortByteString
    ba = ShortByteString -> (CStringLen -> IO String) -> IO String
    forall a. ShortByteString -> (CStringLen -> IO a) -> IO a
    BS8.useAsCStringLen ShortByteString
    ba ((CStringLen -> IO String) -> IO String)
    -> (CStringLen -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \CStringLen
    fp -> CStringLen -> IO String
    peekPosixString CStringLen
    fp

    -- | This mimics the filepath dencoder base uses on unix,
    -- with the small distinction that we're not truncating at NUL bytes (because we're not at
    -- the outer FFI layer).
    encodeWithBasePosix :: String -> IO BS8.ShortByteString
    encodeWithBasePosix :: String -> IO ShortByteString
    encodeWithBasePosix String
    str = String -> (CStringLen -> IO ShortByteString) -> IO ShortByteString
    forall a. String -> (CStringLen -> IO a) -> IO a
    withPosixString String
    str ((CStringLen -> IO ShortByteString) -> IO ShortByteString)
    -> (CStringLen -> IO ShortByteString) -> IO ShortByteString
    forall a b. (a -> b) -> a -> b
    $ \CStringLen
    cstr -> CStringLen -> IO ShortByteString
    BS8.packCStringLen CStringLen
    cstr

    -- | This mimics the filepath decoder base uses on windows,
    -- with the small distinction that we're not truncating at NUL bytes (because we're not at
    -- the outer FFI layer).
    decodeWithBaseWindows :: BS16.ShortByteString -> IO String
    decodeWithBaseWindows :: ShortByteString -> IO String
    decodeWithBaseWindows ShortByteString
    ba = ShortByteString -> ((Ptr Word16, Int) -> IO String) -> IO String
    forall a. ShortByteString -> ((Ptr Word16, Int) -> IO a) -> IO a
    BS16.useAsCWStringLen ShortByteString
    ba (((Ptr Word16, Int) -> IO String) -> IO String)
    -> ((Ptr Word16, Int) -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \(Ptr Word16, Int)
    fp -> (Ptr Word16, Int) -> IO String
    peekWindowsString (Ptr Word16, Int)
    fp

    -- | This mimics the filepath dencoder base uses on windows,
    -- with the small distinction that we're not truncating at NUL bytes (because we're not at
    -- the outer FFI layer).
    encodeWithBaseWindows :: String -> IO BS16.ShortByteString
    encodeWithBaseWindows :: String -> IO ShortByteString
    encodeWithBaseWindows String
    str = String
    -> (Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString
    forall a. String -> (Int -> Ptr Word16 -> IO a) -> IO a
    withWindowsString String
    str ((Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString)
    -> (Int -> Ptr Word16 -> IO ShortByteString) -> IO ShortByteString
    forall a b. (a -> b) -> a -> b
    $ \Int
    l Ptr Word16
    cstr -> (Ptr Word16, Int) -> IO ShortByteString
    BS16.packCWStringLen (Ptr Word16
    cstr, Int
    l)

    -- -----------------------------------------------------------------------------
    -- Types
    --

    data EncodingException =
        EncodingError String (Maybe Word8)
        -- ^ Could not decode a byte sequence because it was invalid under
        -- the given encoding, or ran out of input in mid-decode.
        deriving (EncodingException -> EncodingException -> Bool
    (EncodingException -> EncodingException -> Bool)
    -> (EncodingException -> EncodingException -> Bool)
    -> Eq EncodingException
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: EncodingException -> EncodingException -> Bool
    == :: EncodingException -> EncodingException -> Bool
    $c/= :: EncodingException -> EncodingException -> Bool
    /= :: EncodingException -> EncodingException -> Bool
    Eq, Typeable)

    showEncodingException :: EncodingException -> String
    showEncodingException :: EncodingException -> String
    showEncodingException (EncodingError String
    desc (Just Word8
    w))
        = String
    "Cannot decode byte '\\x" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String -> String
    forall a. Integral a => a -> String -> String
    showHex Word8
    w (String
    "': " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    desc)
    showEncodingException (EncodingError String
    desc Maybe Word8
    Nothing)
        = String
    "Cannot decode input: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    desc

    instance Show EncodingException where
        show :: EncodingException -> String
    show = EncodingException -> String
    showEncodingException

    instance Exception EncodingException

    instance NFData EncodingException where
        rnf :: EncodingException -> ()
    rnf (EncodingError String
    desc Maybe Word8
    w) = String -> ()
    forall a. NFData a => a -> ()
    rnf String
    desc () -> () -> ()
    forall a b. a -> b -> b
    `seq` Maybe Word8 -> ()
    forall a. NFData a => a -> ()
    rnf Maybe Word8
    w

    -- -----------------------------------------------------------------------------
    -- Words
    --

    wNUL :: Word16
    wNUL :: Word16
    wNUL = Word16
    0x00