{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude
, BangPatterns
, NondecreasingIndentation
, MagicHash
#-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module GHC.IO.Encoding.UTF8 (
utf8, mkUTF8,
utf8_bom, mkUTF8_bom
) where
import GHC.Base
import GHC.Real
import GHC.Num
import GHC.IORef
import GHC.IO.Buffer
import GHC.IO.Encoding.Failure
import GHC.IO.Encoding.Types
import GHC.Word
import Data.Bits
utf8 :: TextEncoding
utf8 :: TextEncoding
utf8 = CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
ErrorOnCodingFailure
mkUTF8 :: CodingFailureMode -> TextEncoding
mkUTF8 :: CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-8",
mkTextDecoder :: IO (TextDecoder ())
mkTextDecoder = CodingFailureMode -> IO (TextDecoder ())
utf8_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder ())
mkTextEncoder = CodingFailureMode -> IO (TextEncoder ())
utf8_EF CodingFailureMode
cfm }
utf8_DF :: CodingFailureMode -> IO (TextDecoder ())
utf8_DF :: CodingFailureMode -> IO (TextDecoder ())
utf8_DF CodingFailureMode
cfm =
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec {
encode :: CodeBuffer Word8 Char
encode = CodeBuffer Word8 Char
utf8_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 = forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf8_EF :: CodingFailureMode -> IO (TextEncoder ())
utf8_EF :: CodingFailureMode -> IO (TextEncoder ())
utf8_EF CodingFailureMode
cfm =
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec {
encode :: CodeBuffer Char Word8
encode = CodeBuffer Char Word8
utf8_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 = forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO ()
getState = forall (m :: * -> *) a. Monad m => a -> m a
return (),
setState :: () -> IO ()
setState = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
})
utf8_bom :: TextEncoding
utf8_bom :: TextEncoding
utf8_bom = CodingFailureMode -> TextEncoding
mkUTF8_bom CodingFailureMode
ErrorOnCodingFailure
mkUTF8_bom :: CodingFailureMode -> TextEncoding
mkUTF8_bom :: CodingFailureMode -> TextEncoding
mkUTF8_bom CodingFailureMode
cfm = TextEncoding { textEncodingName :: String
textEncodingName = String
"UTF-8BOM",
mkTextDecoder :: IO (TextDecoder Bool)
mkTextDecoder = CodingFailureMode -> IO (TextDecoder Bool)
utf8_bom_DF CodingFailureMode
cfm,
mkTextEncoder :: IO (TextEncoder Bool)
mkTextEncoder = CodingFailureMode -> IO (TextEncoder Bool)
utf8_bom_EF CodingFailureMode
cfm }
utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool)
utf8_bom_DF :: CodingFailureMode -> IO (TextDecoder Bool)
utf8_bom_DF CodingFailureMode
cfm = do
IORef Bool
ref <- forall a. a -> IO (IORef a)
newIORef Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec {
encode :: CodeBuffer Word8 Char
encode = IORef Bool -> CodeBuffer Word8 Char
utf8_bom_decode IORef Bool
ref,
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 = forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO Bool
getState = forall a. IORef a -> IO a
readIORef IORef Bool
ref,
setState :: Bool -> IO ()
setState = forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref
})
utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf8_bom_EF :: CodingFailureMode -> IO (TextEncoder Bool)
utf8_bom_EF CodingFailureMode
cfm = do
IORef Bool
ref <- forall a. a -> IO (IORef a)
newIORef Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferCodec {
encode :: CodeBuffer Char Word8
encode = IORef Bool -> CodeBuffer Char Word8
utf8_bom_encode IORef Bool
ref,
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 = forall (m :: * -> *) a. Monad m => a -> m a
return (),
getState :: IO Bool
getState = forall a. IORef a -> IO a
readIORef IORef Bool
ref,
setState :: Bool -> IO ()
setState = forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref
})
utf8_bom_decode :: IORef Bool -> DecodeBuffer
utf8_bom_decode :: IORef Bool -> CodeBuffer Word8 Char
utf8_bom_decode IORef Bool
ref
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
Bool
first <- forall a. IORef a -> IO a
readIORef IORef Bool
ref
if Bool -> Bool
not Bool
first
then CodeBuffer Word8 Char
utf8_decode Buffer Word8
input Buffer Char
output
else do
let no_bom :: IO (CodingProgress, Buffer Word8, Buffer Char)
no_bom = do forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False; CodeBuffer Word8 Char
utf8_decode Buffer Word8
input Buffer Char
output
if Int
iw forall a. Num a => a -> a -> a
- Int
ir forall a. Ord a => a -> a -> Bool
< Int
1 then 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
if (Word8
c0 forall a. Eq a => a -> a -> Bool
/= Word8
bom0) then IO (CodingProgress, Buffer Word8, Buffer Char)
no_bom else do
if Int
iw forall a. Num a => a -> a -> a
- Int
ir forall a. Ord a => a -> a -> Bool
< Int
2 then forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
InputUnderflow,Buffer Word8
input,Buffer Char
output) else do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
if (Word8
c1 forall a. Eq a => a -> a -> Bool
/= Word8
bom1) then IO (CodingProgress, Buffer Word8, Buffer Char)
no_bom else do
if Int
iw forall a. Num a => a -> a -> a
- Int
ir forall a. Ord a => a -> a -> Bool
< Int
3 then forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
InputUnderflow,Buffer Word8
input,Buffer Char
output) else do
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
2)
if (Word8
c2 forall a. Eq a => a -> a -> Bool
/= Word8
bom2) then IO (CodingProgress, Buffer Word8, Buffer Char)
no_bom else do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
CodeBuffer Word8 Char
utf8_decode Buffer Word8
input{ bufL :: Int
bufL = Int
ir forall a. Num a => a -> a -> a
+ Int
3 } Buffer Char
output
utf8_bom_encode :: IORef Bool -> EncodeBuffer
utf8_bom_encode :: IORef Bool -> CodeBuffer Char Word8
utf8_bom_encode IORef Bool
ref 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 <- forall a. IORef a -> IO a
readIORef IORef Bool
ref
if Bool -> Bool
not Bool
b then CodeBuffer Char Word8
utf8_encode Buffer Char
input Buffer Word8
output
else if Int
os forall a. Num a => a -> a -> a
- Int
ow forall a. Ord a => a -> a -> Bool
< Int
3
then forall (m :: * -> *) a. Monad m => a -> m a
return (CodingProgress
OutputUnderflow,Buffer Char
input,Buffer Word8
output)
else do
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
ref Bool
False
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
bom0
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
1) Word8
bom1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
2) Word8
bom2
CodeBuffer Char Word8
utf8_encode Buffer Char
input Buffer Word8
output{ bufR :: Int
bufR = Int
owforall a. Num a => a -> a -> a
+Int
3 }
bom0, bom1, bom2 :: Word8
bom0 :: Word8
bom0 = Word8
0xef
bom1 :: Word8
bom1 = Word8
0xbb
bom2 :: Word8
bom2 = Word8
0xbf
utf8_decode :: DecodeBuffer
utf8_decode :: CodeBuffer Word8 Char
utf8_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 forall a. Ord a => a -> a -> Bool
>= Int
os = forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Int
ir forall a. Ord a => a -> a -> Bool
>= Int
iw = 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
case Word8
c0 of
Word8
_ | Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0x7f -> do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Int -> Char
unsafeChr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0))
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irforall a. Num a => a -> a -> a
+Int
1) Int
ow'
| Word8
c0 forall a. Ord a => a -> a -> Bool
>= Word8
0xc0 Bool -> Bool -> Bool
&& Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xc1 -> IO (CodingProgress, Buffer Word8, Buffer Char)
invalid
| Word8
c0 forall a. Ord a => a -> a -> Bool
>= Word8
0xc2 Bool -> Bool -> Bool
&& Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xdf ->
if Int
iw forall a. Num a => a -> a -> a
- Int
ir forall a. Ord a => a -> a -> Bool
< Int
2 then forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow else do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
if (Word8
c1 forall a. Ord a => a -> a -> Bool
< Word8
0x80 Bool -> Bool -> Bool
|| Word8
c1 forall a. Ord a => a -> a -> Bool
>= Word8
0xc0) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word8 -> Word8 -> Char
chr2 Word8
c0 Word8
c1)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irforall a. Num a => a -> a -> a
+Int
2) Int
ow'
| Word8
c0 forall a. Ord a => a -> a -> Bool
>= Word8
0xe0 Bool -> Bool -> Bool
&& Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xef ->
case Int
iw forall a. Num a => a -> a -> a
- Int
ir of
Int
1 -> forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
Int
2 -> do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
if Bool -> Bool
not (Word8 -> Word8 -> Word8 -> Bool
validate3 Word8
c0 Word8
c1 Word8
0x80)
then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
Int
_ -> do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
2)
if Bool -> Bool
not (Word8 -> Word8 -> Word8 -> Bool
validate3 Word8
c0 Word8
c1 Word8
c2) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word8 -> Word8 -> Word8 -> Char
chr3 Word8
c0 Word8
c1 Word8
c2)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irforall a. Num a => a -> a -> a
+Int
3) Int
ow'
| Word8
c0 forall a. Ord a => a -> a -> Bool
>= Word8
0xf0 ->
case Int
iw forall a. Num a => a -> a -> a
- Int
ir of
Int
1 -> forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
Int
2 -> do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
if Bool -> Bool
not (Word8 -> Word8 -> Word8 -> Word8 -> Bool
validate4 Word8
c0 Word8
c1 Word8
0x80 Word8
0x80)
then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
Int
3 -> do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
2)
if Bool -> Bool
not (Word8 -> Word8 -> Word8 -> Word8 -> Bool
validate4 Word8
c0 Word8
c1 Word8
c2 Word8
0x80)
then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Word8, Buffer Char)
done CodingProgress
InputUnderflow Int
ir Int
ow
Int
_ -> do
Word8
c1 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
1)
Word8
c2 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
2)
Word8
c3 <- RawBuffer Word8 -> Int -> IO Word8
readWord8Buf RawBuffer Word8
iraw (Int
irforall a. Num a => a -> a -> a
+Int
3)
if Bool -> Bool
not (Word8 -> Word8 -> Word8 -> Word8 -> Bool
validate4 Word8
c0 Word8
c1 Word8
c2 Word8
c3) then IO (CodingProgress, Buffer Word8, Buffer Char)
invalid else do
Int
ow' <- RawBuffer Char -> Int -> Char -> IO Int
writeCharBuf RawBuffer Char
oraw Int
ow (Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 Word8
c0 Word8
c1 Word8
c2 Word8
c3)
Int -> Int -> IO (CodingProgress, Buffer Word8, Buffer Char)
loop (Int
irforall a. Num a => a -> a -> a
+Int
4) Int
ow'
| Bool
otherwise ->
IO (CodingProgress, Buffer Word8, Buffer Char)
invalid
where
invalid :: IO (CodingProgress, Buffer Word8, Buffer Char)
invalid = 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 = forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir 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
utf8_encode :: EncodeBuffer
utf8_encode :: CodeBuffer Char Word8
utf8_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 = forall (m :: * -> *) a. Monad m => a -> m a
return (a
why,
if Int
ir 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
ow forall a. Ord a => a -> a -> Bool
>= Int
os = forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow
| Int
ir forall a. Ord a => a -> a -> Bool
>= Int
iw = forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InputUnderflow 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 forall a. Ord a => a -> a -> Bool
<= Int
0x7F -> do
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owforall a. Num a => a -> a -> a
+Int
1)
| Int
x forall a. Ord a => a -> a -> Bool
<= Int
0x07FF ->
if Int
os forall a. Num a => a -> a -> a
- Int
ow forall a. Ord a => a -> a -> Bool
< Int
2 then forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
let (Word8
c1,Word8
c2) = Char -> (Word8, Word8)
ord2 Char
c
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
1) Word8
c2
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owforall a. Num a => a -> a -> a
+Int
2)
| Int
x forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF -> if Char -> Bool
isSurrogate Char
c then forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
InvalidSequence Int
ir Int
ow else do
if Int
os forall a. Num a => a -> a -> a
- Int
ow forall a. Ord a => a -> a -> Bool
< Int
3 then forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
let (Word8
c1,Word8
c2,Word8
c3) = Char -> (Word8, Word8, Word8)
ord3 Char
c
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
1) Word8
c2
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
2) Word8
c3
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owforall a. Num a => a -> a -> a
+Int
3)
| Bool
otherwise -> do
if Int
os forall a. Num a => a -> a -> a
- Int
ow forall a. Ord a => a -> a -> Bool
< Int
4 then forall {m :: * -> *} {a}.
Monad m =>
a -> Int -> Int -> m (a, Buffer Char, Buffer Word8)
done CodingProgress
OutputUnderflow Int
ir Int
ow else do
let (Word8
c1,Word8
c2,Word8
c3,Word8
c4) = Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw Int
ow Word8
c1
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
1) Word8
c2
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
2) Word8
c3
RawBuffer Word8 -> Int -> Word8 -> IO ()
writeWord8Buf RawBuffer Word8
oraw (Int
owforall a. Num a => a -> a -> a
+Int
3) Word8
c4
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir' (Int
owforall a. Num a => a -> a -> a
+Int
4)
in
Int -> Int -> IO (CodingProgress, Buffer Char, Buffer Word8)
loop Int
ir0 Int
ow0
ord2 :: Char -> (Word8,Word8)
ord2 :: Char -> (Word8, Word8)
ord2 Char
c = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0x80 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
0x07ff) (Word8
x1,Word8
x2)
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Num a => a -> a -> a
+ Int
0xC0
x2 :: Word8
x2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
ord3 :: Char -> (Word8,Word8,Word8)
ord3 :: Char -> (Word8, Word8, Word8)
ord3 Char
c = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0x0800 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
0xffff) (Word8
x1,Word8
x2,Word8
x3)
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Num a => a -> a -> a
+ Int
0xE0
x2 :: Word8
x2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
x3 :: Word8
x3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
ord4 :: Char -> (Word8,Word8,Word8,Word8)
ord4 :: Char -> (Word8, Word8, Word8, Word8)
ord4 Char
c = forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n forall a. Ord a => a -> a -> Bool
>= Int
0x10000) (Word8
x1,Word8
x2,Word8
x3,Word8
x4)
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
18) forall a. Num a => a -> a -> a
+ Int
0xF0
x2 :: Word8
x2 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
x3 :: Word8
x3 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((Int
n forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
x4 :: Word8
x4 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (Int
n forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80
chr2 :: Word8 -> Word8 -> Char
chr2 :: Word8 -> Word8 -> Char
chr2 (W8# Word8#
x1#) (W8# Word8#
x2#) = Char# -> Char
C# (Int# -> Char#
chr# (Int#
z1# Int# -> Int# -> Int#
+# Int#
z2#))
where
!y1# :: Int#
y1# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x1#)
!y2# :: Int#
y2# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x2#)
!z1# :: Int#
z1# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y1# Int# -> Int# -> Int#
-# Int#
0xC0#) Int#
6#
!z2# :: Int#
z2# = Int#
y2# Int# -> Int# -> Int#
-# Int#
0x80#
{-# INLINE chr2 #-}
chr3 :: Word8 -> Word8 -> Word8 -> Char
chr3 :: Word8 -> Word8 -> Word8 -> Char
chr3 (W8# Word8#
x1#) (W8# Word8#
x2#) (W8# Word8#
x3#) = Char# -> Char
C# (Int# -> Char#
chr# (Int#
z1# Int# -> Int# -> Int#
+# Int#
z2# Int# -> Int# -> Int#
+# Int#
z3#))
where
!y1# :: Int#
y1# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x1#)
!y2# :: Int#
y2# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x2#)
!y3# :: Int#
y3# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x3#)
!z1# :: Int#
z1# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y1# Int# -> Int# -> Int#
-# Int#
0xE0#) Int#
12#
!z2# :: Int#
z2# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y2# Int# -> Int# -> Int#
-# Int#
0x80#) Int#
6#
!z3# :: Int#
z3# = Int#
y3# Int# -> Int# -> Int#
-# Int#
0x80#
{-# INLINE chr3 #-}
chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char
chr4 (W8# Word8#
x1#) (W8# Word8#
x2#) (W8# Word8#
x3#) (W8# Word8#
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# (Word8# -> Word#
word8ToWord# Word8#
x1#)
!y2# :: Int#
y2# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x2#)
!y3# :: Int#
y3# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x3#)
!y4# :: Int#
y4# = Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
x4#)
!z1# :: Int#
z1# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y1# Int# -> Int# -> Int#
-# Int#
0xF0#) Int#
18#
!z2# :: Int#
z2# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y2# Int# -> Int# -> Int#
-# Int#
0x80#) Int#
12#
!z3# :: Int#
z3# = Int# -> Int# -> Int#
uncheckedIShiftL# (Int#
y3# Int# -> Int# -> Int#
-# Int#
0x80#) Int#
6#
!z4# :: Int#
z4# = Int#
y4# Int# -> Int# -> Int#
-# Int#
0x80#
{-# INLINE chr4 #-}
between :: Word8
-> Word8
-> Word8
-> Bool
between :: Word8 -> Word8 -> Word8 -> Bool
between Word8
x Word8
y Word8
z = Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
y Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
z
{-# INLINE between #-}
validate3 :: Word8 -> Word8 -> Word8 -> Bool
{-# INLINE validate3 #-}
validate3 :: Word8 -> Word8 -> Word8 -> Bool
validate3 Word8
x1 Word8
x2 Word8
x3 = Bool
validate3_1 Bool -> Bool -> Bool
||
Bool
validate3_2 Bool -> Bool -> Bool
||
Bool
validate3_3 Bool -> Bool -> Bool
||
Bool
validate3_4
where
validate3_1 :: Bool
validate3_1 = (Word8
x1 forall a. Eq a => a -> a -> Bool
== Word8
0xE0) Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0xA0 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF
validate3_2 :: Bool
validate3_2 = Word8 -> Word8 -> Word8 -> Bool
between Word8
x1 Word8
0xE1 Word8
0xEC Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF
validate3_3 :: Bool
validate3_3 = Word8
x1 forall a. Eq a => a -> a -> Bool
== Word8
0xED Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x80 Word8
0x9F Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF
validate3_4 :: Bool
validate3_4 = Word8 -> Word8 -> Word8 -> Bool
between Word8
x1 Word8
0xEE Word8
0xEF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF
validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
{-# INLINE validate4 #-}
validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool
validate4 Word8
x1 Word8
x2 Word8
x3 Word8
x4 = Bool
validate4_1 Bool -> Bool -> Bool
||
Bool
validate4_2 Bool -> Bool -> Bool
||
Bool
validate4_3
where
validate4_1 :: Bool
validate4_1 = Word8
x1 forall a. Eq a => a -> a -> Bool
== Word8
0xF0 Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x90 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x4 Word8
0x80 Word8
0xBF
validate4_2 :: Bool
validate4_2 = Word8 -> Word8 -> Word8 -> Bool
between Word8
x1 Word8
0xF1 Word8
0xF3 Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x4 Word8
0x80 Word8
0xBF
validate4_3 :: Bool
validate4_3 = Word8
x1 forall a. Eq a => a -> a -> Bool
== Word8
0xF4 Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x2 Word8
0x80 Word8
0x8F Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x3 Word8
0x80 Word8
0xBF Bool -> Bool -> Bool
&&
Word8 -> Word8 -> Word8 -> Bool
between Word8
x4 Word8
0x80 Word8
0xBF