(original) (raw)
{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude , BangPatterns , NondecreasingIndentation , MagicHash #-} {-# OPTIONS_GHC -funbox-strict-fields #-}
module GHC.IO.Encoding.UTF16 ( utf16, mkUTF16, utf16_decode, utf16_encode,
utf16be, mkUTF16be, utf16be_decode, utf16be_encode,
utf16le, mkUTF16le, utf16le_decode, utf16le_encode, ) where
import GHC.Base import GHC.Real import GHC.Num
import GHC.IO.Buffer import GHC.IO.Encoding.Failure import GHC.IO.Encoding.Types import GHC.Word import Data.Bits import GHC.IORef
utf16 :: TextEncoding utf16 :: TextEncoding utf16 = CodingFailureMode -> TextEncoding mkUTF16 CodingFailureMode ErrorOnCodingFailure
mkUTF16 :: CodingFailureMode -> TextEncoding mkUTF16 :: CodingFailureMode -> TextEncoding mkUTF16 CodingFailureMode cfm = TextEncoding { textEncodingName :: String textEncodingName = String "UTF-16", mkTextDecoder :: IO (TextDecoder (Maybe DecodeBuffer)) mkTextDecoder = CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) utf16_DF CodingFailureMode cfm, mkTextEncoder :: IO (TextEncoder Bool) mkTextEncoder = CodingFailureMode -> IO (TextEncoder Bool) utf16_EF CodingFailureMode cfm }
utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) utf16_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer)) utf16_DF CodingFailureMode cfm = do IORef (Maybe DecodeBuffer) seen_bom <- Maybe DecodeBuffer -> IO (IORef (Maybe DecodeBuffer)) forall a. a -> IO (IORef a) newIORef Maybe DecodeBuffer forall a. Maybe a Nothing TextDecoder (Maybe DecodeBuffer) -> IO (TextDecoder (Maybe DecodeBuffer)) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: DecodeBuffer encode = IORef (Maybe DecodeBuffer) -> DecodeBuffer utf16_decode IORef (Maybe DecodeBuffer) seen_bom, 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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO (Maybe DecodeBuffer) getState = IORef (Maybe DecodeBuffer) -> IO (Maybe DecodeBuffer) forall a. IORef a -> IO a readIORef IORef (Maybe DecodeBuffer) seen_bom, setState :: Maybe DecodeBuffer -> IO () setState = IORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Maybe DecodeBuffer) seen_bom })
utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF :: CodingFailureMode -> IO (TextEncoder Bool) utf16_EF CodingFailureMode cfm = do IORef Bool done_bom <- Bool -> IO (IORef Bool) forall a. a -> IO (IORef a) newIORef Bool False TextEncoder Bool -> IO (TextEncoder Bool) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: CodeBuffer Char Word8 encode = IORef Bool -> CodeBuffer Char Word8 utf16_encode IORef Bool done_bom, 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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO Bool getState = IORef Bool -> IO Bool forall a. IORef a -> IO a readIORef IORef Bool done_bom, setState :: Bool -> IO () setState = IORef Bool -> Bool -> IO () forall a. IORef a -> a -> IO () writeIORef IORef Bool done_bom })
utf16_encode :: IORef Bool -> EncodeBuffer utf16_encode :: IORef Bool -> CodeBuffer Char Word8 utf16_encode IORef Bool done_bom Buffer Char input 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 ow, bufSize :: forall e. Buffer e -> Int bufSize=Int os } = do Bool b <- IORef Bool -> IO Bool forall a. IORef a -> IO a readIORef IORef Bool done_bom if Bool b then CodeBuffer Char Word8 utf16_native_encode Buffer Char input Buffer Word8 output else 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 2 then (CodingProgress, Buffer Char, Buffer Word8) -> IO (CodingProgress, Buffer Char, Buffer Word8) forall (m :: * -> *) a. Monad m => a -> m a return (CodingProgress OutputUnderflow,Buffer Char input,Buffer Word8 output) else do IORef Bool -> Bool -> IO () forall a. IORef a -> a -> IO () writeIORef IORef Bool done_bom Bool True RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw Int ow Word8 bom1 RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int
- Word8 bom2 CodeBuffer Char Word8
utf16_native_encode Buffer Char input Buffer Word8 output{ bufR :: Int bufR = Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int 2 }
utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer utf16_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer utf16_decode IORef (Maybe DecodeBuffer) seen_bom input :: Buffer Word8 input@Buffer{ bufRaw :: forall e. Buffer e -> RawBuffer e bufRaw=RawBuffer Word8 iraw, bufL :: forall e. Buffer e -> Int bufL=Int ir, bufR :: forall e. Buffer e -> Int bufR=Int iw, bufSize :: forall e. Buffer e -> Int bufSize=Int _ } Buffer Char output = do Maybe DecodeBuffer mb <- IORef (Maybe DecodeBuffer) -> IO (Maybe DecodeBuffer) forall a. IORef a -> IO a readIORef IORef (Maybe DecodeBuffer) seen_bom case Maybe DecodeBuffer mb of Just DecodeBuffer decode -> DecodeBuffer decode Buffer Word8 input Buffer Char output Maybe DecodeBuffer Nothing -> if Int iw Int -> Int -> Int forall a. Num a => a -> a -> a - Int ir Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 2 then (CodingProgress, Buffer Word8, Buffer Char) -> IO (CodingProgress, Buffer Word8, Buffer Char) forall (m :: * -> *) a. Monad m => a -> m a return (CodingProgress InputUnderflow,Buffer Word8 input,Buffer Char output) else do Word8 c0 <- RawBuffer Word8 -> Int -> IO Word8 readWord8Buf RawBuffer Word8 iraw Int ir Word8 c1 <- RawBuffer Word8 -> Int -> IO Word8 readWord8Buf RawBuffer Word8 iraw (Int irInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1) case () of () _ | Word8 c0 Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 bomB Bool -> Bool -> Bool && Word8 c1 Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 bomL -> do IORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Maybe DecodeBuffer) seen_bom (DecodeBuffer -> Maybe DecodeBuffer forall a. a -> Maybe a Just DecodeBuffer utf16be_decode) DecodeBuffer utf16be_decode Buffer Word8 input{ bufL :: Int bufL= Int irInt -> Int -> Int forall a. Num a => a -> a -> a +Int 2 } Buffer Char output | Word8 c0 Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 bomL Bool -> Bool -> Bool && Word8 c1 Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 bomB -> do IORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Maybe DecodeBuffer) seen_bom (DecodeBuffer -> Maybe DecodeBuffer forall a. a -> Maybe a Just DecodeBuffer utf16le_decode) DecodeBuffer utf16le_decode Buffer Word8 input{ bufL :: Int bufL= Int irInt -> Int -> Int forall a. Num a => a -> a -> a +Int 2 } Buffer Char output | Bool otherwise -> do IORef (Maybe DecodeBuffer) -> Maybe DecodeBuffer -> IO () forall a. IORef a -> a -> IO () writeIORef IORef (Maybe DecodeBuffer) seen_bom (DecodeBuffer -> Maybe DecodeBuffer forall a. a -> Maybe a Just DecodeBuffer utf16_native_decode) DecodeBuffer utf16_native_decode Buffer Word8 input Buffer Char output
bomB, bomL, bom1, bom2 :: Word8 bomB :: Word8 bomB = Word8 0xfe bomL :: Word8 bomL = Word8 0xff
utf16_native_decode :: DecodeBuffer utf16_native_decode :: DecodeBuffer utf16_native_decode = DecodeBuffer utf16be_decode
utf16_native_encode :: EncodeBuffer utf16_native_encode :: CodeBuffer Char Word8 utf16_native_encode = CodeBuffer Char Word8 utf16be_encode
bom1 :: Word8 bom1 = Word8 bomB bom2 :: Word8 bom2 = Word8 bomL
utf16be :: TextEncoding utf16be :: TextEncoding utf16be = CodingFailureMode -> TextEncoding mkUTF16be CodingFailureMode ErrorOnCodingFailure
mkUTF16be :: CodingFailureMode -> TextEncoding mkUTF16be :: CodingFailureMode -> TextEncoding mkUTF16be CodingFailureMode cfm = TextEncoding { textEncodingName :: String textEncodingName = String "UTF-16BE", mkTextDecoder :: IO (TextDecoder ()) mkTextDecoder = CodingFailureMode -> IO (TextDecoder ()) utf16be_DF CodingFailureMode cfm, mkTextEncoder :: IO (TextEncoder ()) mkTextEncoder = CodingFailureMode -> IO (TextEncoder ()) utf16be_EF CodingFailureMode cfm }
utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16be_DF CodingFailureMode cfm = TextDecoder () -> IO (TextDecoder ()) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: DecodeBuffer encode = DecodeBuffer utf16be_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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO () getState = () -> IO () 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 (m :: * -> *) a. Monad m => a -> m a return () })
utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16be_EF CodingFailureMode cfm = TextEncoder () -> IO (TextEncoder ()) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: CodeBuffer Char Word8 encode = CodeBuffer Char Word8 utf16be_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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO () getState = () -> IO () 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 (m :: * -> *) a. Monad m => a -> m a return () })
utf16le :: TextEncoding utf16le :: TextEncoding utf16le = CodingFailureMode -> TextEncoding mkUTF16le CodingFailureMode ErrorOnCodingFailure
mkUTF16le :: CodingFailureMode -> TextEncoding mkUTF16le :: CodingFailureMode -> TextEncoding mkUTF16le CodingFailureMode cfm = TextEncoding { textEncodingName :: String textEncodingName = String "UTF16-LE", mkTextDecoder :: IO (TextDecoder ()) mkTextDecoder = CodingFailureMode -> IO (TextDecoder ()) utf16le_DF CodingFailureMode cfm, mkTextEncoder :: IO (TextEncoder ()) mkTextEncoder = CodingFailureMode -> IO (TextEncoder ()) utf16le_EF CodingFailureMode cfm }
utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF :: CodingFailureMode -> IO (TextDecoder ()) utf16le_DF CodingFailureMode cfm = TextDecoder () -> IO (TextDecoder ()) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: DecodeBuffer encode = DecodeBuffer utf16le_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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO () getState = () -> IO () 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 (m :: * -> *) a. Monad m => a -> m a return () })
utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF :: CodingFailureMode -> IO (TextEncoder ()) utf16le_EF CodingFailureMode cfm = TextEncoder () -> IO (TextEncoder ()) forall (m :: * -> *) a. Monad m => a -> m a return (BufferCodec { encode :: CodeBuffer Char Word8 encode = CodeBuffer Char Word8 utf16le_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 (m :: * -> *) a. Monad m => a -> m a return (), getState :: IO () getState = () -> IO () 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 (m :: * -> *) a. Monad m => a -> m a return () })
utf16be_decode :: DecodeBuffer
utf16be_decode :: DecodeBuffer
utf16be_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
Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let x1 :: Word16
x1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1
if Word16 -> Bool
validate1 Word16
x1
then do Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x1))
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow'
else if Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then 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 else do
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
let x2 :: Word16
x2 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c2 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c3
if Bool -> Bool
not (Word16 -> Word16 -> Bool
validate2 Word16
x1 Word16
x2) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow'
where
invalid :: IO (CodingProgress, Buffer Word8, Buffer Char)
invalid = 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
InvalidSequence Int
ir Int
ow
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 (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 :: Int bufL=Int 0, bufR :: Int bufR=Int 0 } else Buffer Word8 input{ bufL :: Int bufL=Int ir }, Buffer Char output{ bufR :: Int bufR=Int ow }) in Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char) loop Int ir0 Int ow0
utf16le_decode :: DecodeBuffer
utf16le_decode :: DecodeBuffer
utf16le_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
Word8
c0 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw Int
ir
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
let x1 :: Word16
x1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c1 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0
if Word16 -> Bool
validate1 Word16
x1
then do Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x1))
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Int
ow'
else if Int
iw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ir Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then 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 else do
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2)
Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3)
let x2 :: Word16
x2 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c3 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
shiftL Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c2
if Bool -> Bool
not (Word16 -> Word16 -> Bool
validate2 Word16
x1 Word16
x2) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word16 -> Word16 -> Char
chr2 Word16
x1 Word16
x2)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4) Int
ow'
where
invalid :: IO (CodingProgress, Buffer Word8, Buffer Char)
invalid = 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
InvalidSequence Int
ir Int
ow
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 (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 :: Int bufL=Int 0, bufR :: Int bufR=Int 0 } else Buffer Word8 input{ bufL :: Int bufL=Int ir }, Buffer Char output{ bufR :: Int bufR=Int ow }) in Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char) loop Int ir0 Int ow0
utf16be_encode :: EncodeBuffer
utf16be_encode :: CodeBuffer Char Word8
utf16be_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 (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 :: Int
bufL=Int
0, bufR :: Int
bufR=Int
0 }
else Buffer Char
input{ bufL :: Int
bufL=Int
ir },
Buffer Word8
output{ bufR :: Int
bufR=Int
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
(Char
c,Int
ir') <- RawBuffer Char -> Int -> IO (Char, Int)
readCharBuf RawBuffer Char
iraw Int
ir
case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x10000 -> if Char -> Bool
isSurrogate Char
c 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
InvalidSequence Int
ir Int
ow else 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 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
- (Int -> Word8 forall a b. (Integral a, Num b) => a -> b fromIntegral Int x) 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 -> do
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
n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
c1 :: Word8
c1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
c2 :: Word8
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
10)
n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
c3 :: Word8
c3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8Buf RawBuffer Word8 oraw Int ow Word8 c1 RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int
- Word8 c2 RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int 2) Word8 c3 RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int 3) Word8 c4 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
utf16le_encode :: EncodeBuffer utf16le_encode :: CodeBuffer Char Word8 utf16le_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 (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 :: Int bufL=Int 0, bufR :: Int bufR=Int 0 } else Buffer Char input{ bufL :: Int bufL=Int ir }, Buffer Word8 output{ bufR :: Int bufR=Int 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 (Char c,Int ir') <- RawBuffer Char -> Int -> IO (Char, Int) readCharBuf RawBuffer Char iraw Int ir case Char -> Int ord Char c of Int x | Int x Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int 0x10000 -> if Char -> Bool isSurrogate Char c 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 InvalidSequence Int ir Int ow else 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
- (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftRInt 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
n1 :: Int
n1 = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
c1 :: Word8
c1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xD8)
c2 :: Word8
c2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n1 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
10)
n2 :: Int
n2 = Int
n1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF
c3 :: Word8
c3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n2 Int -> Int -> Int
forall a. Bits a => a -> Int -> a
shiftR Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xDC)
c4 :: Word8
c4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n2
RawBuffer Word8 -> Int -> Word8 -> IO ()writeWord8Buf RawBuffer Word8 oraw Int ow Word8 c2 RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int
- Word8 c1 RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int 2) Word8 c4 RawBuffer Word8 -> Int -> Word8 -> IO () writeWord8Buf RawBuffer Word8 oraw (Int owInt -> Int -> Int forall a. Num a => a -> a -> a +Int 3) Word8 c3 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
chr2 :: Word16 -> Word16 -> Char chr2 :: Word16 -> Word16 -> Char chr2 (W16# Word16# a#) (W16# Word16# b#) = Char# -> Char C# (Int# -> Char# chr# (Int# upper# Int# -> Int# -> Int# +# Int# lower# Int# -> Int# -> Int# +# Int# 0x10000#)) where !x# :: Int# x# = Word# -> Int# word2Int# (Word16# -> Word# word16ToWord# Word16# a#) !y# :: Int# y# = Word# -> Int# word2Int# (Word16# -> Word# word16ToWord# Word16# b#) !upper# :: Int# upper# = Int# -> Int# -> Int# uncheckedIShiftL# (Int# x# Int# -> Int# -> Int# -# Int# 0xD800#) Int# 10# !lower# :: Int# lower# = Int# y# Int# -> Int# -> Int# -# Int# 0xDC00# {-# INLINE chr2 #-}
validate1 :: Word16 -> Bool validate1 :: Word16 -> Bool validate1 Word16 x1 = (Word16 x1 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool >= Word16 0 Bool -> Bool -> Bool && Word16 x1 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool < Word16 0xD800) Bool -> Bool -> Bool || Word16 x1 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool > Word16 0xDFFF {-# INLINE validate1 #-}
validate2 :: Word16 -> Word16 -> Bool validate2 :: Word16 -> Word16 -> Bool validate2 Word16 x1 Word16 x2 = Word16 x1 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool >= Word16 0xD800 Bool -> Bool -> Bool && Word16 x1 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool <= Word16 0xDBFF Bool -> Bool -> Bool && Word16 x2 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool >= Word16 0xDC00 Bool -> Bool -> Bool && Word16 x2 Word16 -> Word16 -> Bool forall a. Ord a => a -> a -> Bool <= Word16 0xDFFF {-# INLINE validate2 #-}