{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, NondecreasingIndentation
, MagicHash
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module GHC.IO.Encoding.UTF32 (
utf32, mkUTF32,
utf32_decode,
utf32_encode,
utf32be, mkUTF32be,
utf32be_decode,
utf32be_encode,
utf32le, mkUTF32le,
utf32le_decode,
utf32le_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
utf32 :: TextEncoding
utf32 :: TextEncoding
utf32 = CodingFailureMode -> TextEncoding
mkUTF32 CodingFailureMode
ErrorOnCodingFailure
mkUTF32 :: CodingFailureMode -> TextEncoding
mkUTF32 :: CodingFailureMode -> TextEncoding
mkUTF32 CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32",
mkTextDecoder :: IO (TextDecoder (Maybe DecodeBuffer))
mkTextDecoder = CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))
utf32_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder Bool)
mkTextEncoder = CodingFailureMode -> IO (TextEncoder Bool)
utf32_EF CodingFailureMode
cfm }
utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))
utf32_DF :: CodingFailureMode -> IO (TextDecoder (Maybe DecodeBuffer))
utf32_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 :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: DecodeBuffer
encode = IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf32_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
})
utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf32_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf32_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 :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Char Word8
encode = IORef Bool -> CodeBuffer Char Word8
utf32_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
})
utf32_encode :: IORef Bool -> EncodeBuffer
utf32_encode :: IORef Bool -> CodeBuffer Char Word8
utf32_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
utf32_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
4
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
bom0
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Word8
bom1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Word8
bom2
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
bom3
CodeBuffer Char Word8
utf32_native_encode Buffer Char
input Buffer Word8
output{ bufR :: Int
bufR = Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4 }
utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf32_decode :: IORef (Maybe DecodeBuffer) -> DecodeBuffer
utf32_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
4 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)
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)
case () of
()
_ | Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom0 Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom1 Bool -> Bool -> Bool
&& Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom2 Bool -> Bool -> Bool
&& Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom3 -> 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
utf32be_decode)
DecodeBuffer
utf32be_decode Buffer Word8
input{ bufL :: Int
bufL= Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4 } Buffer Char
output
()
_ | Word8
c0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom3 Bool -> Bool -> Bool
&& Word8
c1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom2 Bool -> Bool -> Bool
&& Word8
c2 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom1 Bool -> Bool -> Bool
&& Word8
c3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bom0 -> 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
utf32le_decode)
DecodeBuffer
utf32le_decode Buffer Word8
input{ bufL :: Int
bufL= Int
irInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
4 } 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
utf32_native_decode)
DecodeBuffer
utf32_native_decode Buffer Word8
input Buffer Char
output
bom0, bom1, bom2, bom3 :: Word8
bom0 :: Word8
bom0 = Word8
0
bom1 :: Word8
bom1 = Word8
0
bom2 :: Word8
bom2 = Word8
0xfe
bom3 :: Word8
bom3 = Word8
0xff
utf32_native_decode :: DecodeBuffer
utf32_native_decode :: DecodeBuffer
utf32_native_decode = DecodeBuffer
utf32be_decode
utf32_native_encode :: EncodeBuffer
utf32_native_encode :: CodeBuffer Char Word8
utf32_native_encode = CodeBuffer Char Word8
utf32be_encode
utf32be :: TextEncoding
utf32be :: TextEncoding
utf32be = CodingFailureMode -> TextEncoding
mkUTF32be CodingFailureMode
ErrorOnCodingFailure
mkUTF32be :: CodingFailureMode -> TextEncoding
mkUTF32be :: CodingFailureMode -> TextEncoding
mkUTF32be CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32BE",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf32be_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf32be_EF CodingFailureMode
cfm }
utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32be_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32be_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: DecodeBuffer
encode = DecodeBuffer
utf32be_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 ()
})
utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32be_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32be_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Char Word8
encode = CodeBuffer Char Word8
utf32be_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 ()
})
utf32le :: TextEncoding
utf32le :: TextEncoding
utf32le = CodingFailureMode -> TextEncoding
mkUTF32le CodingFailureMode
ErrorOnCodingFailure
mkUTF32le :: CodingFailureMode -> TextEncoding
mkUTF32le :: CodingFailureMode -> TextEncoding
mkUTF32le CodingFailureMode
cfm = TextEncoding :: forall dstate estate.
String
-> IO (TextDecoder dstate)
-> IO (TextEncoder estate)
-> TextEncoding
TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-32LE",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf32le_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf32le_EF CodingFailureMode
cfm }
utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32le_DF :: CodingFailureMode -> IO (TextDecoder ())
utf32le_DF CodingFailureMode
cfm =
TextDecoder () -> IO (TextDecoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: DecodeBuffer
encode = DecodeBuffer
utf32le_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 ()
})
utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32le_EF :: CodingFailureMode -> IO (TextEncoder ())
utf32le_EF CodingFailureMode
cfm =
TextEncoder () -> IO (TextEncoder ())
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec :: forall from to state.
CodeBuffer from to
-> (Buffer from -> Buffer to -> IO (Buffer from, Buffer to))
-> IO ()
-> IO state
-> (state -> IO ())
-> BufferCodec from to state
BufferCodec {
encode :: CodeBuffer Char Word8
encode = CodeBuffer Char Word8
utf32le_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 ()
})
utf32be_decode :: DecodeBuffer
utf32be_decode :: DecodeBuffer
utf32be_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
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 = 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)
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 x1 :: Char
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
c0 Word8
c1 Word8
c2 Word8
c3
if Bool -> Bool
not (Char -> Bool
validate Char
x1) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow Char
x1
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
utf32le_decode :: DecodeBuffer
utf32le_decode :: DecodeBuffer
utf32le_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
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 = 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)
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 x1 :: Char
x1 = Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
c3 Word8
c2 Word8
c1 Word8
c0
if Bool -> Bool
not (Char -> Bool
validate Char
x1) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow Char
x1
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
utf32be_encode :: EncodeBuffer
utf32be_encode :: CodeBuffer Char Word8
utf32be_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
4 = 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
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
let (Word8
c0,Word8
c1,Word8
c2,Word8
c3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c0
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) 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
c2
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
utf32le_encode :: EncodeBuffer
utf32le_encode :: CodeBuffer Char Word8
utf32le_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
4 = 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
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
let (Word8
c0,Word8
c1,Word8
c2,Word8
c3) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c3
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) 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
c1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
3) Word8
c0
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
chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 (W8# Word#
x1#) (W8# Word#
x2#) (W8# Word#
x3#) (W8# Word#
x4#) =
Char# -> Char
C# (Int# -> Char#
chr# (Int#
z1# Int# -> Int# -> Int#
+# Int#
z2# Int# -> Int# -> Int#
+# Int#
z3# Int# -> Int# -> Int#
+# Int#
z4#))
where
!y1# :: Int#
y1# = Word# -> Int#
word2Int# Word#
x1#
!y2# :: Int#
y2# = Word# -> Int#
word2Int# Word#
x2#
!y3# :: Int#
y3# = Word# -> Int#
word2Int# Word#
x3#
!y4# :: Int#
y4# = Word# -> Int#
word2Int# Word#
x4#
!z1# :: Int#
z1# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y1# Int#
24#
!z2# :: Int#
z2# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y2# Int#
16#
!z3# :: Int#
z3# = Int# -> Int# -> Int#
uncheckedIShiftL# Int#
y3# Int#
8#
!z4# :: Int#
z4# = Int#
y4#
{-# INLINE chr4 #-}
ord4 :: Char -> (Word8,Word8,Word8,Word8)
ord4 :: Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c = (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
24),
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
16),
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 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
where
x :: Int
x = Char -> Int
ord Char
c
{-# INLINE ord4 #-}
validate :: Char -> Bool
validate :: Char -> Bool
validate Char
c = (Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0 Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xD800) Bool -> Bool -> Bool
|| (Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xDFFF Bool -> Bool -> Bool
&& Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF)
where x1 :: Int
x1 = Char -> Int
ord Char
c
{-# INLINE validate #-}