{-# LANGUAGE CPP #-}
module Streamly.Internal.Unicode.Stream
(
decodeLatin1
, CodingFailureMode(..)
, writeCharUtf8'
, parseCharUtf8With
, decodeUtf8
, decodeUtf8'
, decodeUtf8_
, decodeUtf16le'
, decodeUtf16le
, DecodeError(..)
, DecodeState
, CodePoint
, decodeUtf8Either
, resumeDecodeUtf8Either
, decodeUtf8Chunks
, decodeUtf8Chunks'
, decodeUtf8Chunks_
, encodeLatin1
, encodeLatin1'
, encodeLatin1_
, readCharUtf8'
, readCharUtf8
, readCharUtf8_
, encodeUtf8
, encodeUtf8'
, encodeUtf8_
, encodeStrings
, encodeUtf16le'
, encodeUtf16le
, stripHead
, lines
, words
, unlines
, unwords
, decodeUtf8D
, decodeUtf8D'
, decodeUtf8D_
, encodeUtf8D
, encodeUtf8D'
, encodeUtf8D_
, decodeUtf8EitherD
, resumeDecodeUtf8EitherD
, fromStr#
, mkEvenW8Chunks
, swapByteOrder
, decodeUtf8Lax
, encodeLatin1Lax
, encodeUtf8Lax
)
where
#include "inline.hs"
#include "MachDeps.h"
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bits (shiftR, shiftL, (.|.), (.&.))
import Data.Char (chr, ord)
#if MIN_VERSION_base(4,17,0)
import Data.Char (generalCategory, GeneralCategory(Space))
#endif
import Data.Word (Word8, Word16)
import Foreign.Marshal.Alloc (mallocBytes)
import Foreign.Storable (Storable(..))
#ifndef __GHCJS__
import Fusion.Plugin.Types (Fuse(..))
#endif
import GHC.Base (assert, unsafeChr)
import GHC.Exts (Addr#)
import GHC.IO.Encoding.Failure (isSurrogate)
import GHC.Ptr (Ptr (..), plusPtr)
import System.IO.Unsafe (unsafePerformIO)
import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
import Streamly.Internal.Data.Fold (Fold)
import Streamly.Internal.Data.Parser (Parser)
import Streamly.Internal.Data.Stream (Stream)
import Streamly.Internal.Data.Stream (Step (..))
import Streamly.Internal.Data.SVar.Type (adaptState)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Unbox (Unbox(peekAt))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))
import Streamly.Internal.System.IO (unsafeInlineIO)
import qualified Streamly.Data.Fold as Fold
import qualified Streamly.Data.Unfold as Unfold
import qualified Streamly.Internal.Data.Array as Array
import qualified Streamly.Internal.Data.Parser as Parser (Parser)
import qualified Streamly.Internal.Data.Parser as ParserD
import qualified Streamly.Internal.Data.Stream as Stream
import qualified Streamly.Internal.Data.Stream as D
import Prelude hiding (lines, words, unlines, unwords)
#include "DocTestUnicodeStream.hs"
{-# INLINE decodeLatin1 #-}
decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char
decodeLatin1 :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeLatin1 = (Word8 -> Char) -> Stream m Word8 -> Stream m Char
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Char
unsafeChr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
{-# INLINE encodeLatin1' #-}
encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8
encodeLatin1' :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeLatin1' = (Char -> Word8) -> Stream m Char -> Stream m Word8
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
forall {a}. Num a => Char -> a
convert
where
convert :: Char -> a
convert Char
c =
let codepoint :: Int
codepoint = Char -> Int
ord Char
c
in if Int
codepoint Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
255
then [Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Streamly.Unicode.encodeLatin1 invalid " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
"input char codepoint " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
codepoint
else Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
codepoint
{-# INLINE encodeLatin1 #-}
encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8
encodeLatin1 :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeLatin1 = (Char -> Word8) -> Stream m Char -> Stream m Word8
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)
{-# INLINE encodeLatin1_ #-}
encodeLatin1_ :: Monad m => Stream m Char -> Stream m Word8
encodeLatin1_ :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeLatin1_ = (Char -> Word8) -> Stream m Char -> Stream m Word8
forall a b. (a -> b) -> Stream m a -> Stream m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) (Stream m Char -> Stream m Word8)
-> (Stream m Char -> Stream m Char)
-> Stream m Char
-> Stream m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Stream m Char -> Stream m Char
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Stream m a -> Stream m a
Stream.filter (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Char
chr Int
255)
{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
{-# INLINE encodeLatin1Lax #-}
encodeLatin1Lax :: Monad m => Stream m Char -> Stream m Word8
encodeLatin1Lax :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeLatin1Lax = Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeLatin1
type CodePoint = Int
type DecodeState = Word8
data DecodeError = DecodeError !DecodeState !CodePoint deriving Int -> DecodeError -> [Char] -> [Char]
[DecodeError] -> [Char] -> [Char]
DecodeError -> [Char]
(Int -> DecodeError -> [Char] -> [Char])
-> (DecodeError -> [Char])
-> ([DecodeError] -> [Char] -> [Char])
-> Show DecodeError
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> DecodeError -> [Char] -> [Char]
showsPrec :: Int -> DecodeError -> [Char] -> [Char]
$cshow :: DecodeError -> [Char]
show :: DecodeError -> [Char]
$cshowList :: [DecodeError] -> [Char] -> [Char]
showList :: [DecodeError] -> [Char] -> [Char]
Show
decodeTable :: [Word8]
decodeTable :: [Word8]
decodeTable = [
Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0, Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,
Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0, Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,
Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0, Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,
Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0, Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,Word8
0,
Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1,Word8
1, Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,Word8
9,
Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7, Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,Word8
7,
Word8
8,Word8
8,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2, Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,Word8
2,
Word8
10,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
3,Word8
4,Word8
3,Word8
3, Word8
11,Word8
6,Word8
6,Word8
6,Word8
5,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,Word8
8,
Word8
0,Word8
12,Word8
24,Word8
36,Word8
60,Word8
96,Word8
84,Word8
12,Word8
12,Word8
12,Word8
48,Word8
72, Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,
Word8
12, Word8
0,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12, Word8
0,Word8
12, Word8
0,Word8
12,Word8
12, Word8
12,Word8
24,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
24,Word8
12,Word8
24,Word8
12,Word8
12,
Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
24,Word8
12,Word8
12,Word8
12,Word8
12, Word8
12,Word8
24,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
24,Word8
12,Word8
12,
Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
36,Word8
12,Word8
36,Word8
12,Word8
12, Word8
12,Word8
36,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
36,Word8
12,Word8
36,Word8
12,Word8
12,
Word8
12,Word8
36,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12,Word8
12
]
{-# INLINE utf8dLength #-}
utf8dLength :: Int
utf8dLength :: Int
utf8dLength = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
decodeTable
{-# NOINLINE utf8d #-}
utf8d :: Ptr Word8
utf8d :: Ptr Word8
utf8d = IO (Ptr Word8) -> Ptr Word8
forall a. IO a -> a
unsafePerformIO (IO (Ptr Word8) -> Ptr Word8) -> IO (Ptr Word8) -> Ptr Word8
forall a b. (a -> b) -> a -> b
$ do
let size :: Int
size = Int
utf8dLength
Ptr Word8
p <- IO (Ptr Word8) -> IO (Ptr Word8)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr Word8) -> IO (Ptr Word8))
-> IO (Ptr Word8) -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
size
IO (Ptr Word8) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
forall a b. (a -> b) -> a -> b
$ Fold IO Word8 (Ptr Word8) -> Stream IO Word8 -> IO (Ptr Word8)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
D.fold
((Ptr Word8 -> Word8 -> IO (Ptr Word8))
-> IO (Ptr Word8) -> Fold IO Word8 (Ptr Word8)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
Fold.foldlM' (\Ptr Word8
b Word8
a -> Ptr Word8 -> Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Word8
b Word8
a IO () -> IO (Ptr Word8) -> IO (Ptr Word8)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8
b Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)) (Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
p))
([Word8] -> Stream IO Word8
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [Word8]
decodeTable)
Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
p
{-# INLINE_NORMAL unsafePeekElemOff #-}
unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
unsafePeekElemOff Ptr a
p Int
i =
let !x :: a
x = IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr a
p Int
i
in a
x
{-# INLINE showMemory #-}
showMemory ::
forall a. (Show a, Storable a) => Ptr a -> Ptr a -> String
showMemory :: forall a. (Show a, Storable a) => Ptr a -> Ptr a -> [Char]
showMemory Ptr a
cur Ptr a
end
| Ptr a
cur Ptr a -> Ptr a -> Bool
forall a. Ord a => a -> a -> Bool
< Ptr a
end =
let cur1 :: Ptr b
cur1 = Ptr a
cur Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. (?callStack::CallStack) => a
undefined :: a)
in a -> [Char]
forall a. Show a => a -> [Char]
show (IO a -> a
forall a. IO a -> a
unsafeInlineIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
cur) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ptr a -> Ptr a -> [Char]
forall a. (Show a, Storable a) => Ptr a -> Ptr a -> [Char]
showMemory Ptr a
forall {b}. Ptr b
cur1 Ptr a
end
showMemory Ptr a
_ Ptr a
_ = [Char]
""
{-# INLINE decode0 #-}
decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
decode0 :: Ptr Word8 -> Word8 -> Tuple' Word8 Int
decode0 Ptr Word8
table Word8
byte =
let !t :: Word8
t = Ptr Word8
table Ptr Word8 -> Int -> Word8
forall a. Storable a => Ptr a -> Int -> a
`unsafePeekElemOff` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte
!codep' :: Int
codep' = (Int
0xff Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
t) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte
!state' :: Word8
state' = Ptr Word8
table Ptr Word8 -> Int -> Word8
forall a. Storable a => Ptr a -> Int -> a
`unsafePeekElemOff` (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
t)
in Bool -> Tuple' Word8 Int -> Tuple' Word8 Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ((Word8
byte Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
showByte)
Bool -> Bool -> Bool
&& (Word8
state' Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0 Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
showByte [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
showTable)))
(Word8 -> Int -> Tuple' Word8 Int
forall a b. a -> b -> Tuple' a b
Tuple' Word8
state' Int
codep')
where
utf8tableEnd :: Ptr b
utf8tableEnd = Ptr Word8
table Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
364
showByte :: [Char]
showByte = [Char]
"Streamly: decode0: byte: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
byte
showTable :: [Char]
showTable = [Char]
" table: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ptr Word8 -> Ptr Word8 -> [Char]
forall a. (Show a, Storable a) => Ptr a -> Ptr a -> [Char]
showMemory Ptr Word8
table Ptr Word8
forall {b}. Ptr b
utf8tableEnd
{-# INLINE decode1 #-}
decode1
:: Ptr Word8
-> DecodeState
-> CodePoint
-> Word8
-> Tuple' DecodeState CodePoint
decode1 :: Ptr Word8 -> Word8 -> Int -> Word8 -> Tuple' Word8 Int
decode1 Ptr Word8
table Word8
state Int
codep Word8
byte =
let !t :: Word8
t = Ptr Word8
table Ptr Word8 -> Int -> Word8
forall a. Storable a => Ptr a -> Int -> a
`unsafePeekElemOff` Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte
!codep' :: Int
codep' = (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3f) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
codep Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
6)
!state' :: Word8
state' = Ptr Word8
table Ptr Word8 -> Int -> Word8
forall a. Storable a => Ptr a -> Int -> a
`unsafePeekElemOff`
(Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
state Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
t)
in Bool -> Tuple' Word8 Int -> Tuple' Word8 Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
codep' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF
Bool -> Bool -> Bool
|| [Char] -> Bool
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char]
showByte [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> Int -> [Char]
forall {a} {a}. (Show a, Show a) => a -> a -> [Char]
showState Word8
state Int
codep))
(Word8 -> Int -> Tuple' Word8 Int
forall a b. a -> b -> Tuple' a b
Tuple' Word8
state' Int
codep')
where
utf8tableEnd :: Ptr b
utf8tableEnd = Ptr Word8
table Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
364
showByte :: [Char]
showByte = [Char]
"Streamly: decode1: byte: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
byte
showState :: a -> a -> [Char]
showState a
st a
cp =
[Char]
" state: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
st [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" codepoint: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
cp [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
" table: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Ptr Word8 -> Ptr Word8 -> [Char]
forall a. (Show a, Storable a) => Ptr a -> Ptr a -> [Char]
showMemory Ptr Word8
table Ptr Word8
forall {b}. Ptr b
utf8tableEnd
#ifndef __GHCJS__
{-# ANN type UTF8DecodeState Fuse #-}
#endif
data UTF8DecodeState s a
= UTF8DecodeInit s
| UTF8DecodeInit1 s Word8
| UTF8DecodeFirst s Word8
| UTF8Decoding s !DecodeState !CodePoint
| YieldAndContinue a (UTF8DecodeState s a)
| Done
{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
resumeDecodeUtf8EitherD
:: Monad m
=> DecodeState
-> CodePoint
-> D.Stream m Word8
-> D.Stream m (Either DecodeError Char)
resumeDecodeUtf8EitherD :: forall (m :: * -> *).
Monad m =>
Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
resumeDecodeUtf8EitherD Word8
dst Int
codep (D.Stream State StreamK m Word8 -> s -> m (Step s Word8)
step s
state) =
let stt :: UTF8DecodeState s a
stt =
if Word8
dst Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
then s -> UTF8DecodeState s a
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
state
else s -> Word8 -> Int -> UTF8DecodeState s a
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
state Word8
dst Int
codep
in (State StreamK m (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> UTF8DecodeState s (Either DecodeError Char)
-> Stream m (Either DecodeError Char)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream (Ptr Word8
-> State StreamK m (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall {m :: * -> *} {a}.
Ptr Word8
-> State StreamK m a
-> UTF8DecodeState s (Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
step' Ptr Word8
utf8d) UTF8DecodeState s (Either DecodeError Char)
forall {a}. UTF8DecodeState s a
stt
where
{-# INLINE_LATE step' #-}
step' :: Ptr Word8
-> State StreamK m a
-> UTF8DecodeState s (Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
step' Ptr Word8
_ State StreamK m a
gst (UTF8DecodeInit s
st) = do
Step s Word8
r <- State StreamK m Word8 -> s -> m (Step s Word8)
step (State StreamK m a -> State StreamK m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ case Step s Word8
r of
Yield Word8
x s
s -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (s -> Word8 -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeInit1 s
s Word8
x)
Skip s
s -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (s -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
s)
Step s Word8
Stop -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip UTF8DecodeState s (Either DecodeError Char)
forall s a. UTF8DecodeState s a
Done
step' Ptr Word8
_ State StreamK m a
_ (UTF8DecodeInit1 s
st Word8
x) = do
case Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f of
Bool
False ->
Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue
(Char -> Either DecodeError Char
forall a b. b -> Either a b
Right (Char -> Either DecodeError Char)
-> Char -> Either DecodeError Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
(s -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
st)
Bool
True -> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ s -> Word8 -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeFirst s
st Word8
x
step' Ptr Word8
table State StreamK m a
_ (UTF8DecodeFirst s
st Word8
x) = do
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Tuple' Word8 Int
decode0 Ptr Word8
table Word8
x
Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$
case Word8
sv of
Word8
12 ->
UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue (DecodeError -> Either DecodeError Char
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Char)
-> DecodeError -> Either DecodeError Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> DecodeError
DecodeError Word8
0 (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
(s -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
st)
Word8
0 -> [Char]
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"unreachable state"
Word8
_ -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
st Word8
sv Int
cp)
step' Ptr Word8
table State StreamK m a
gst (UTF8Decoding s
st Word8
statePtr Int
codepointPtr) = do
Step s Word8
r <- State StreamK m Word8 -> s -> m (Step s Word8)
step (State StreamK m a -> State StreamK m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
case Step s Word8
r of
Yield Word8
x s
s -> do
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Int -> Word8 -> Tuple' Word8 Int
decode1 Ptr Word8
table Word8
statePtr Int
codepointPtr Word8
x
Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$
case Word8
sv of
Word8
0 -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue (Char -> Either DecodeError Char
forall a b. b -> Either a b
Right (Char -> Either DecodeError Char)
-> Char -> Either DecodeError Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr Int
cp)
(s -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
s)
Word8
12 ->
UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue (DecodeError -> Either DecodeError Char
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Char)
-> DecodeError -> Either DecodeError Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> DecodeError
DecodeError Word8
statePtr Int
codepointPtr)
(s -> Word8 -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeInit1 s
s Word8
x)
Word8
_ -> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
s Word8
sv Int
cp)
Skip s
s -> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s (Either DecodeError Char)
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
s Word8
statePtr Int
codepointPtr)
Step s Word8
Stop -> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. s -> Step s a
Skip (UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> UTF8DecodeState s (Either DecodeError Char)
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue (DecodeError -> Either DecodeError Char
forall a b. a -> Either a b
Left (DecodeError -> Either DecodeError Char)
-> DecodeError -> Either DecodeError Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> DecodeError
DecodeError Word8
statePtr Int
codepointPtr) UTF8DecodeState s (Either DecodeError Char)
forall s a. UTF8DecodeState s a
Done
step' Ptr Word8
_ State StreamK m a
_ (YieldAndContinue Either DecodeError Char
c UTF8DecodeState s (Either DecodeError Char)
s) = Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)))
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a b. (a -> b) -> a -> b
$ Either DecodeError Char
-> UTF8DecodeState s (Either DecodeError Char)
-> Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. a -> s -> Step s a
Yield Either DecodeError Char
c UTF8DecodeState s (Either DecodeError Char)
s
step' Ptr Word8
_ State StreamK m a
_ UTF8DecodeState s (Either DecodeError Char)
Done = Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
-> m (Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
(UTF8DecodeState s (Either DecodeError Char))
(Either DecodeError Char)
forall s a. Step s a
Stop
{-# INLINE_NORMAL decodeUtf8EitherD #-}
decodeUtf8EitherD :: Monad m
=> D.Stream m Word8 -> D.Stream m (Either DecodeError Char)
decodeUtf8EitherD :: forall (m :: * -> *).
Monad m =>
Stream m Word8 -> Stream m (Either DecodeError Char)
decodeUtf8EitherD = Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
forall (m :: * -> *).
Monad m =>
Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
resumeDecodeUtf8EitherD Word8
0 Int
0
{-# INLINE decodeUtf8Either #-}
decodeUtf8Either :: Monad m
=> Stream m Word8 -> Stream m (Either DecodeError Char)
decodeUtf8Either :: forall (m :: * -> *).
Monad m =>
Stream m Word8 -> Stream m (Either DecodeError Char)
decodeUtf8Either = Stream m Word8 -> Stream m (Either DecodeError Char)
forall (m :: * -> *).
Monad m =>
Stream m Word8 -> Stream m (Either DecodeError Char)
decodeUtf8EitherD
{-# INLINE resumeDecodeUtf8Either #-}
resumeDecodeUtf8Either
:: Monad m
=> DecodeState
-> CodePoint
-> Stream m Word8
-> Stream m (Either DecodeError Char)
resumeDecodeUtf8Either :: forall (m :: * -> *).
Monad m =>
Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
resumeDecodeUtf8Either = Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
forall (m :: * -> *).
Monad m =>
Word8
-> Int -> Stream m Word8 -> Stream m (Either DecodeError Char)
resumeDecodeUtf8EitherD
data CodingFailureMode
= TransliterateCodingFailure
| ErrorOnCodingFailure
| DropOnCodingFailure
deriving (Int -> CodingFailureMode -> [Char] -> [Char]
[CodingFailureMode] -> [Char] -> [Char]
CodingFailureMode -> [Char]
(Int -> CodingFailureMode -> [Char] -> [Char])
-> (CodingFailureMode -> [Char])
-> ([CodingFailureMode] -> [Char] -> [Char])
-> Show CodingFailureMode
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> CodingFailureMode -> [Char] -> [Char]
showsPrec :: Int -> CodingFailureMode -> [Char] -> [Char]
$cshow :: CodingFailureMode -> [Char]
show :: CodingFailureMode -> [Char]
$cshowList :: [CodingFailureMode] -> [Char] -> [Char]
showList :: [CodingFailureMode] -> [Char] -> [Char]
Show)
{-# INLINE replacementChar #-}
replacementChar :: Char
replacementChar :: Char
replacementChar = Char
'\xFFFD'
data UTF8CharDecodeState a
= UTF8CharDecodeInit
| UTF8CharDecoding !DecodeState !CodePoint
{-# INLINE parseCharUtf8WithD #-}
parseCharUtf8WithD ::
Monad m => CodingFailureMode -> ParserD.Parser Word8 m Char
parseCharUtf8WithD :: forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Parser Word8 m Char
parseCharUtf8WithD CodingFailureMode
cfm = (UTF8CharDecodeState Any
-> Word8 -> m (Step (UTF8CharDecodeState Any) Char))
-> m (Initial (UTF8CharDecodeState Any) Char)
-> (UTF8CharDecodeState Any
-> m (Step (UTF8CharDecodeState Any) Char))
-> Parser Word8 m Char
forall a (m :: * -> *) b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b
ParserD.Parser (Ptr Word8
-> UTF8CharDecodeState Any
-> Word8
-> m (Step (UTF8CharDecodeState Any) Char)
forall {m :: * -> *} {a} {a}.
Monad m =>
Ptr Word8
-> UTF8CharDecodeState a
-> Word8
-> m (Step (UTF8CharDecodeState a) Char)
step' Ptr Word8
utf8d) m (Initial (UTF8CharDecodeState Any) Char)
forall {a} {b}. m (Initial (UTF8CharDecodeState a) b)
initial UTF8CharDecodeState Any -> m (Step (UTF8CharDecodeState Any) Char)
forall {m :: * -> *} {a} {s}.
Monad m =>
UTF8CharDecodeState a -> m (Step s Char)
extract
where
prefix :: [Char]
prefix = [Char]
"Streamly.Internal.Data.Stream.parseCharUtf8WithD:"
{-# INLINE initial #-}
initial :: m (Initial (UTF8CharDecodeState a) b)
initial = Initial (UTF8CharDecodeState a) b
-> m (Initial (UTF8CharDecodeState a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Initial (UTF8CharDecodeState a) b
-> m (Initial (UTF8CharDecodeState a) b))
-> Initial (UTF8CharDecodeState a) b
-> m (Initial (UTF8CharDecodeState a) b)
forall a b. (a -> b) -> a -> b
$ UTF8CharDecodeState a -> Initial (UTF8CharDecodeState a) b
forall s b. s -> Initial s b
ParserD.IPartial UTF8CharDecodeState a
forall a. UTF8CharDecodeState a
UTF8CharDecodeInit
handleError :: [Char] -> Bool -> Step (UTF8CharDecodeState a) Char
handleError [Char]
err Bool
souldBackTrack =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> Step (UTF8CharDecodeState a) Char
forall s b. [Char] -> Step s b
ParserD.Error [Char]
err
CodingFailureMode
TransliterateCodingFailure ->
case Bool
souldBackTrack of
Bool
True -> Int -> Char -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> b -> Step s b
ParserD.Done Int
1 Char
replacementChar
Bool
False -> Int -> Char -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> b -> Step s b
ParserD.Done Int
0 Char
replacementChar
CodingFailureMode
DropOnCodingFailure ->
case Bool
souldBackTrack of
Bool
True -> Int -> UTF8CharDecodeState a -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> s -> Step s b
ParserD.Continue Int
1 UTF8CharDecodeState a
forall a. UTF8CharDecodeState a
UTF8CharDecodeInit
Bool
False -> Int -> UTF8CharDecodeState a -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> s -> Step s b
ParserD.Continue Int
0 UTF8CharDecodeState a
forall a. UTF8CharDecodeState a
UTF8CharDecodeInit
{-# INLINE step' #-}
step' :: Ptr Word8
-> UTF8CharDecodeState a
-> Word8
-> m (Step (UTF8CharDecodeState a) Char)
step' Ptr Word8
table UTF8CharDecodeState a
UTF8CharDecodeInit Word8
x =
Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char))
-> Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char)
forall a b. (a -> b) -> a -> b
$ case Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f of
Bool
False -> Int -> Char -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> b -> Step s b
ParserD.Done Int
0 (Char -> Step (UTF8CharDecodeState a) Char)
-> Char -> Step (UTF8CharDecodeState a) Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x
Bool
True ->
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Tuple' Word8 Int
decode0 Ptr Word8
table Word8
x
in case Word8
sv of
Word8
12 ->
let msg :: [Char]
msg = [Char]
prefix
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid first UTF8 byte" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
in [Char] -> Bool -> Step (UTF8CharDecodeState a) Char
forall {a}. [Char] -> Bool -> Step (UTF8CharDecodeState a) Char
handleError [Char]
msg Bool
False
Word8
0 -> [Char] -> Step (UTF8CharDecodeState a) Char
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> Step (UTF8CharDecodeState a) Char)
-> [Char] -> Step (UTF8CharDecodeState a) Char
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"unreachable state"
Word8
_ -> Int -> UTF8CharDecodeState a -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> s -> Step s b
ParserD.Continue Int
0 (Word8 -> Int -> UTF8CharDecodeState a
forall a. Word8 -> Int -> UTF8CharDecodeState a
UTF8CharDecoding Word8
sv Int
cp)
step' Ptr Word8
table (UTF8CharDecoding Word8
statePtr Int
codepointPtr) Word8
x = Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char))
-> Step (UTF8CharDecodeState a) Char
-> m (Step (UTF8CharDecodeState a) Char)
forall a b. (a -> b) -> a -> b
$
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Int -> Word8 -> Tuple' Word8 Int
decode1 Ptr Word8
table Word8
statePtr Int
codepointPtr Word8
x
in case Word8
sv of
Word8
0 -> Int -> Char -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> b -> Step s b
ParserD.Done Int
0 (Char -> Step (UTF8CharDecodeState a) Char)
-> Char -> Step (UTF8CharDecodeState a) Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
unsafeChr Int
cp
Word8
12 ->
let msg :: [Char]
msg = [Char]
prefix
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid subsequent UTF8 byte"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"in state"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
statePtr
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"accumulated value"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
codepointPtr
in [Char] -> Bool -> Step (UTF8CharDecodeState a) Char
forall {a}. [Char] -> Bool -> Step (UTF8CharDecodeState a) Char
handleError [Char]
msg Bool
True
Word8
_ -> Int -> UTF8CharDecodeState a -> Step (UTF8CharDecodeState a) Char
forall s b. Int -> s -> Step s b
ParserD.Continue Int
0 (Word8 -> Int -> UTF8CharDecodeState a
forall a. Word8 -> Int -> UTF8CharDecodeState a
UTF8CharDecoding Word8
sv Int
cp)
{-# INLINE extract #-}
extract :: UTF8CharDecodeState a -> m (Step s Char)
extract UTF8CharDecodeState a
UTF8CharDecodeInit = [Char] -> m (Step s Char)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m (Step s Char)) -> [Char] -> m (Step s Char)
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Not enough input"
extract (UTF8CharDecoding Word8
_ Int
_) =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure ->
Step s Char -> m (Step s Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s Char -> m (Step s Char)) -> Step s Char -> m (Step s Char)
forall a b. (a -> b) -> a -> b
$ [Char] -> Step s Char
forall s b. [Char] -> Step s b
ParserD.Error ([Char] -> Step s Char) -> [Char] -> Step s Char
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Not enough input"
CodingFailureMode
TransliterateCodingFailure ->
Step s Char -> m (Step s Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char -> Step s Char
forall s b. Int -> b -> Step s b
ParserD.Done Int
0 Char
replacementChar)
CodingFailureMode
DropOnCodingFailure -> [Char] -> m (Step s Char)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m (Step s Char)) -> [Char] -> m (Step s Char)
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Not enough input"
{-# INLINE writeCharUtf8' #-}
writeCharUtf8' :: Monad m => Parser Word8 m Char
writeCharUtf8' :: forall (m :: * -> *). Monad m => Parser Word8 m Char
writeCharUtf8' = CodingFailureMode -> Parser Word8 m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Parser Word8 m Char
parseCharUtf8WithD CodingFailureMode
ErrorOnCodingFailure
{-# INLINE parseCharUtf8With #-}
parseCharUtf8With ::
Monad m => CodingFailureMode -> Parser.Parser Word8 m Char
parseCharUtf8With :: forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Parser Word8 m Char
parseCharUtf8With = CodingFailureMode -> Parser Word8 m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Parser Word8 m Char
parseCharUtf8WithD
{-# INLINE_NORMAL decodeUtf8WithD #-}
decodeUtf8WithD :: Monad m
=> CodingFailureMode -> D.Stream m Word8 -> D.Stream m Char
decodeUtf8WithD :: forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word8 -> Stream m Char
decodeUtf8WithD CodingFailureMode
cfm (D.Stream State StreamK m Word8 -> s -> m (Step s Word8)
step s
state) =
(State StreamK m Char
-> UTF8DecodeState s Char
-> m (Step (UTF8DecodeState s Char) Char))
-> UTF8DecodeState s Char -> Stream m Char
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream (Ptr Word8
-> State StreamK m Char
-> UTF8DecodeState s Char
-> m (Step (UTF8DecodeState s Char) Char)
forall {m :: * -> *} {a}.
Ptr Word8
-> State StreamK m a
-> UTF8DecodeState s Char
-> m (Step (UTF8DecodeState s Char) Char)
step' Ptr Word8
utf8d) (s -> UTF8DecodeState s Char
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
state)
where
prefix :: [Char]
prefix = [Char]
"Streamly.Internal.Data.Stream.decodeUtf8With: "
{-# INLINE handleError #-}
handleError :: [Char] -> UTF8DecodeState s Char -> UTF8DecodeState s Char
handleError [Char]
e UTF8DecodeState s Char
s =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> UTF8DecodeState s Char
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
e
CodingFailureMode
TransliterateCodingFailure -> Char -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue Char
replacementChar UTF8DecodeState s Char
s
CodingFailureMode
DropOnCodingFailure -> UTF8DecodeState s Char
s
{-# INLINE handleUnderflow #-}
handleUnderflow :: UTF8DecodeState s Char
handleUnderflow =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> UTF8DecodeState s Char
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> UTF8DecodeState s Char)
-> [Char] -> UTF8DecodeState s Char
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Not enough input"
CodingFailureMode
TransliterateCodingFailure -> Char -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue Char
replacementChar UTF8DecodeState s Char
forall s a. UTF8DecodeState s a
Done
CodingFailureMode
DropOnCodingFailure -> UTF8DecodeState s Char
forall s a. UTF8DecodeState s a
Done
{-# INLINE_LATE step' #-}
step' :: Ptr Word8
-> State StreamK m a
-> UTF8DecodeState s Char
-> m (Step (UTF8DecodeState s Char) Char)
step' Ptr Word8
_ State StreamK m a
gst (UTF8DecodeInit s
st) = do
Step s Word8
r <- State StreamK m Word8 -> s -> m (Step s Word8)
step (State StreamK m a -> State StreamK m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ case Step s Word8
r of
Yield Word8
x s
s -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (s -> Word8 -> UTF8DecodeState s Char
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeInit1 s
s Word8
x)
Skip s
s -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (s -> UTF8DecodeState s Char
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
s)
Step s Word8
Stop -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip UTF8DecodeState s Char
forall s a. UTF8DecodeState s a
Done
step' Ptr Word8
_ State StreamK m a
_ (UTF8DecodeInit1 s
st Word8
x) = do
case Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f of
Bool
False ->
Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char)
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall a b. (a -> b) -> a -> b
$ Char -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue
(Int -> Char
unsafeChr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
(s -> UTF8DecodeState s Char
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
st)
Bool
True -> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char)
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall a b. (a -> b) -> a -> b
$ s -> Word8 -> UTF8DecodeState s Char
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeFirst s
st Word8
x
step' Ptr Word8
table State StreamK m a
_ (UTF8DecodeFirst s
st Word8
x) = do
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Tuple' Word8 Int
decode0 Ptr Word8
table Word8
x
Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$
case Word8
sv of
Word8
12 ->
let msg :: [Char]
msg = [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid first UTF8 byte " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
in UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char)
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall a b. (a -> b) -> a -> b
$ [Char] -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall {s}.
[Char] -> UTF8DecodeState s Char -> UTF8DecodeState s Char
handleError [Char]
msg (s -> UTF8DecodeState s Char
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
st)
Word8
0 -> [Char] -> Step (UTF8DecodeState s Char) Char
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"unreachable state"
Word8
_ -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s Char
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
st Word8
sv Int
cp)
step' Ptr Word8
table State StreamK m a
gst (UTF8Decoding s
st Word8
statePtr Int
codepointPtr) = do
Step s Word8
r <- State StreamK m Word8 -> s -> m (Step s Word8)
step (State StreamK m a -> State StreamK m Word8
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
case Step s Word8
r of
Yield Word8
x s
s -> do
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Int -> Word8 -> Tuple' Word8 Int
decode1 Ptr Word8
table Word8
statePtr Int
codepointPtr Word8
x
Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ case Word8
sv of
Word8
0 -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char)
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall a b. (a -> b) -> a -> b
$ Char -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall s a. a -> UTF8DecodeState s a -> UTF8DecodeState s a
YieldAndContinue
(Int -> Char
unsafeChr Int
cp) (s -> UTF8DecodeState s Char
forall s a. s -> UTF8DecodeState s a
UTF8DecodeInit s
s)
Word8
12 ->
let msg :: [Char]
msg = [Char]
prefix
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid subsequent UTF8 byte "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
x
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in state "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
statePtr
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" accumulated value "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
codepointPtr
in UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char)
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall a b. (a -> b) -> a -> b
$ [Char] -> UTF8DecodeState s Char -> UTF8DecodeState s Char
forall {s}.
[Char] -> UTF8DecodeState s Char -> UTF8DecodeState s Char
handleError [Char]
msg (s -> Word8 -> UTF8DecodeState s Char
forall s a. s -> Word8 -> UTF8DecodeState s a
UTF8DecodeInit1 s
s Word8
x)
Word8
_ -> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s Char
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
s Word8
sv Int
cp)
Skip s
s -> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$
UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip (s -> Word8 -> Int -> UTF8DecodeState s Char
forall s a. s -> Word8 -> Int -> UTF8DecodeState s a
UTF8Decoding s
s Word8
statePtr Int
codepointPtr)
Step s Word8
Stop -> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. s -> Step s a
Skip UTF8DecodeState s Char
forall {s}. UTF8DecodeState s Char
handleUnderflow
step' Ptr Word8
_ State StreamK m a
_ (YieldAndContinue Char
c UTF8DecodeState s Char
s) = Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char))
-> Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a b. (a -> b) -> a -> b
$ Char
-> UTF8DecodeState s Char -> Step (UTF8DecodeState s Char) Char
forall s a. a -> s -> Step s a
Yield Char
c UTF8DecodeState s Char
s
step' Ptr Word8
_ State StreamK m a
_ UTF8DecodeState s Char
Done = Step (UTF8DecodeState s Char) Char
-> m (Step (UTF8DecodeState s Char) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (UTF8DecodeState s Char) Char
forall s a. Step s a
Stop
{-# INLINE decodeUtf8D #-}
decodeUtf8D :: Monad m => D.Stream m Word8 -> D.Stream m Char
decodeUtf8D :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D = CodingFailureMode -> Stream m Word8 -> Stream m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word8 -> Stream m Char
decodeUtf8WithD CodingFailureMode
TransliterateCodingFailure
{-# INLINE decodeUtf8 #-}
decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
decodeUtf8 :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8 = Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D
{-# INLINE decodeUtf8D' #-}
decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char
decodeUtf8D' :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D' = CodingFailureMode -> Stream m Word8 -> Stream m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word8 -> Stream m Char
decodeUtf8WithD CodingFailureMode
ErrorOnCodingFailure
{-# INLINE decodeUtf8' #-}
decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char
decodeUtf8' :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8' = Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D'
{-# INLINE decodeUtf8D_ #-}
decodeUtf8D_ :: Monad m => D.Stream m Word8 -> D.Stream m Char
decodeUtf8D_ :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D_ = CodingFailureMode -> Stream m Word8 -> Stream m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word8 -> Stream m Char
decodeUtf8WithD CodingFailureMode
DropOnCodingFailure
{-# INLINE decodeUtf8_ #-}
decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char
decodeUtf8_ :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8_ = Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8D_
{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
{-# INLINE decodeUtf8Lax #-}
decodeUtf8Lax :: Monad m => Stream m Word8 -> Stream m Char
decodeUtf8Lax :: forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8Lax = Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8
data MkEvenW8ChunksState s w8 arr
= MECSInit s
| MECSBuffer w8 s
| MECSYieldAndInit arr s
| MECSYieldAndBuffer arr w8 s
{-# INLINE_NORMAL mkEvenW8Chunks #-}
mkEvenW8Chunks :: Monad m => Stream m (Array Word8) -> Stream m (Array Word8)
mkEvenW8Chunks :: forall (m :: * -> *).
Monad m =>
Stream m (Array Word8) -> Stream m (Array Word8)
mkEvenW8Chunks (D.Stream State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step s
state) = (State StreamK m (Array Word8)
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)))
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Stream m (Array Word8)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m (Array Word8)
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall {m :: * -> *} {a}.
State StreamK m a
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
step1 (s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. s -> MkEvenW8ChunksState s w8 arr
MECSInit s
state)
where
{-# INLINE_LATE step1 #-}
step1 :: State StreamK m a
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
step1 State StreamK m a
gst (MECSInit s
st) = do
Step s (Array Word8)
r <- State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step (State StreamK m a -> State StreamK m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)))
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$
case Step s (Array Word8)
r of
Yield Array Word8
arr s
st1 ->
let len :: Int
len = Array Word8 -> Int
forall a. Unbox a => Array a -> Int
Array.length Array Word8
arr
in if (Int
len Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then let arr1 :: Array Word8
arr1 = Int -> Int -> Array Word8 -> Array Word8
forall a. Unbox a => Int -> Int -> Array a -> Array a
Array.unsafeSliceOffLen Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Array Word8
arr
remElem :: Word8
remElem = Int -> Array Word8 -> Word8
forall a. Unbox a => Int -> Array a -> a
Array.unsafeGetIndex (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Array Word8
arr
in Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
arr1 (Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. w8 -> s -> MkEvenW8ChunksState s w8 arr
MECSBuffer Word8
remElem s
st1)
else Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
arr (s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. s -> MkEvenW8ChunksState s w8 arr
MECSInit s
st1)
Skip s
s -> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Skip (s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. s -> MkEvenW8ChunksState s w8 arr
MECSInit s
s)
Step s (Array Word8)
Stop -> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. Step s a
Stop
step1 State StreamK m a
gst (MECSBuffer Word8
remElem s
st) = do
Step s (Array Word8)
r <- State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step (State StreamK m a -> State StreamK m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)))
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$
case Step s (Array Word8)
r of
Yield Array Word8
arr s
st1 | Array Word8 -> Int
forall a. Unbox a => Array a -> Int
Array.length Array Word8
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Skip (Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. w8 -> s -> MkEvenW8ChunksState s w8 arr
MECSBuffer Word8
remElem s
st1)
Yield Array Word8
arr s
st1 | Array Word8 -> Int
forall a. Unbox a => Array a -> Int
Array.length Array Word8
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 ->
let fstElem :: Word8
fstElem = Int -> Array Word8 -> Word8
forall a. Unbox a => Int -> Array a -> a
Array.unsafeGetIndex Int
0 Array Word8
arr
w16 :: Array Word8
w16 = [Word8] -> Array Word8
forall a. Unbox a => [a] -> Array a
Array.fromList [Word8
remElem, Word8
fstElem]
in Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
w16 (s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. s -> MkEvenW8ChunksState s w8 arr
MECSInit s
st1)
Yield Array Word8
arr s
st1 ->
let len :: Int
len = Array Word8 -> Int
forall a. Unbox a => Array a -> Int
Array.length Array Word8
arr
in if (Int
len Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then let arr1 :: Array Word8
arr1 = Int -> Int -> Array Word8 -> Array Word8
forall a. Unbox a => Int -> Int -> Array a -> Array a
Array.unsafeSliceOffLen Int
1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Array Word8
arr
fstElem :: Word8
fstElem = Int -> Array Word8 -> Word8
forall a. Unbox a => Int -> Array a -> a
Array.unsafeGetIndex Int
0 Array Word8
arr
w16 :: Array Word8
w16 = [Word8] -> Array Word8
forall a. Unbox a => [a] -> Array a
Array.fromList [Word8
remElem, Word8
fstElem]
in Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
w16 (Array Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. arr -> s -> MkEvenW8ChunksState s w8 arr
MECSYieldAndInit Array Word8
arr1 s
st1)
else let arr1 :: Array Word8
arr1 = Int -> Int -> Array Word8 -> Array Word8
forall a. Unbox a => Int -> Int -> Array a -> Array a
Array.unsafeSliceOffLen Int
1 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Array Word8
arr
fstElem :: Word8
fstElem = Int -> Array Word8 -> Word8
forall a. Unbox a => Int -> Array a -> a
Array.unsafeGetIndex Int
0 Array Word8
arr
lstElem :: Word8
lstElem = Int -> Array Word8 -> Word8
forall a. Unbox a => Int -> Array a -> a
Array.unsafeGetIndex (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Array Word8
arr
w16 :: Array Word8
w16 = [Word8] -> Array Word8
forall a. Unbox a => [a] -> Array a
Array.fromList [Word8
remElem, Word8
fstElem]
in Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
w16
(Array Word8
-> Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. arr -> w8 -> s -> MkEvenW8ChunksState s w8 arr
MECSYieldAndBuffer Array Word8
arr1 Word8
lstElem s
st1)
Skip s
s -> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. s -> Step s a
Skip (Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. w8 -> s -> MkEvenW8ChunksState s w8 arr
MECSBuffer Word8
remElem s
s)
Step s (Array Word8)
Stop -> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. Step s a
Stop
step1 State StreamK m a
_ (MECSYieldAndInit Array Word8
arr s
st) =
Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)))
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
arr (s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. s -> MkEvenW8ChunksState s w8 arr
MECSInit s
st)
step1 State StreamK m a
_ (MECSYieldAndBuffer Array Word8
arr Word8
lastElem s
st) =
Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)))
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
-> m (Step
(MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> MkEvenW8ChunksState s Word8 (Array Word8)
-> Step (MkEvenW8ChunksState s Word8 (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
Yield Array Word8
arr (Word8 -> s -> MkEvenW8ChunksState s Word8 (Array Word8)
forall s w8 arr. w8 -> s -> MkEvenW8ChunksState s w8 arr
MECSBuffer Word8
lastElem s
st)
{-# INLINE swapByteOrder #-}
swapByteOrder :: Word16 -> Word16
swapByteOrder :: Word16 -> Word16
swapByteOrder Word16
w = (Word16
w Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. (Word16
w Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
data DecodeUtf16WithState w c s
= U16NoSurrogate s
| U16HighSurrogate w s
| U16D
| U16YAndC c (DecodeUtf16WithState w c s)
{-# INLINE_NORMAL decodeUtf16With #-}
decodeUtf16With ::
Monad m
=> CodingFailureMode
-> D.Stream m Word16
-> D.Stream m Char
decodeUtf16With :: forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word16 -> Stream m Char
decodeUtf16With CodingFailureMode
cfm (D.Stream State StreamK m Word16 -> s -> m (Step s Word16)
step s
state) =
(State StreamK m Char
-> DecodeUtf16WithState Word16 Char s
-> m (Step (DecodeUtf16WithState Word16 Char s) Char))
-> DecodeUtf16WithState Word16 Char s -> Stream m Char
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State StreamK m Char
-> DecodeUtf16WithState Word16 Char s
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall {m :: * -> *} {a}.
State StreamK m a
-> DecodeUtf16WithState Word16 Char s
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
step1 (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
state)
where
prefix :: [Char]
prefix = [Char]
"Streamly.Internal.Unicode.Stream.decodeUtf16With: "
{-# INLINE combineSurrogates #-}
combineSurrogates :: Word16 -> Word16 -> Char
combineSurrogates Word16
hi Word16
lo =
let first10 :: Int
first10 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
hi Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
utf16HighSurrogate) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
10
second10 :: Int
second10 = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
lo Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
utf16LowSurrogate)
in Int -> Char
unsafeChr (Int
0x10000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
first10 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
second10))
{-# INLINE transliterateOrError #-}
transliterateOrError :: [Char]
-> DecodeUtf16WithState w Char s -> DecodeUtf16WithState w Char s
transliterateOrError [Char]
e DecodeUtf16WithState w Char s
s =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> DecodeUtf16WithState w Char s
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
e
CodingFailureMode
TransliterateCodingFailure -> Char
-> DecodeUtf16WithState w Char s -> DecodeUtf16WithState w Char s
forall w c s.
c -> DecodeUtf16WithState w c s -> DecodeUtf16WithState w c s
U16YAndC Char
replacementChar DecodeUtf16WithState w Char s
s
CodingFailureMode
DropOnCodingFailure -> DecodeUtf16WithState w Char s
s
{-# INLINE inputUnderflow #-}
inputUnderflow :: DecodeUtf16WithState w Char s
inputUnderflow =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> DecodeUtf16WithState w Char s
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> DecodeUtf16WithState w Char s)
-> [Char] -> DecodeUtf16WithState w Char s
forall a b. (a -> b) -> a -> b
$ [Char]
prefix [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Input Underflow"
CodingFailureMode
TransliterateCodingFailure -> Char
-> DecodeUtf16WithState w Char s -> DecodeUtf16WithState w Char s
forall w c s.
c -> DecodeUtf16WithState w c s -> DecodeUtf16WithState w c s
U16YAndC Char
replacementChar DecodeUtf16WithState w Char s
forall w c s. DecodeUtf16WithState w c s
U16D
CodingFailureMode
DropOnCodingFailure -> DecodeUtf16WithState w Char s
forall w c s. DecodeUtf16WithState w c s
U16D
{-# INLINE_LATE step1 #-}
step1 :: State StreamK m a
-> DecodeUtf16WithState Word16 Char s
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
step1 State StreamK m a
gst (U16NoSurrogate s
st) = do
Step s Word16
r <- State StreamK m Word16 -> s -> m (Step s Word16)
step (State StreamK m a -> State StreamK m Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char))
-> Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a b. (a -> b) -> a -> b
$
case Step s Word16
r of
Yield Word16
x s
st1
| Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
0xD800 Bool -> Bool -> Bool
|| Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
> Word16
0xDFFF ->
Char
-> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. a -> s -> Step s a
Yield (Int -> Char
unsafeChr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)) (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
st1)
| Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xD800 Bool -> Bool -> Bool
&& Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDBFF ->
DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip (Word16 -> s -> DecodeUtf16WithState Word16 Char s
forall w c s. w -> s -> DecodeUtf16WithState w c s
U16HighSurrogate Word16
x s
st1)
| Bool
otherwise ->
let msg :: [Char]
msg = [Char]
prefix
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid first UTF16 word " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
x
in DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip (DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char)
-> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall a b. (a -> b) -> a -> b
$
[Char]
-> DecodeUtf16WithState Word16 Char s
-> DecodeUtf16WithState Word16 Char s
forall {w} {s}.
[Char]
-> DecodeUtf16WithState w Char s -> DecodeUtf16WithState w Char s
transliterateOrError [Char]
msg (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
st1)
Skip s
st1 -> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
st1)
Step s Word16
Stop -> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. Step s a
Stop
step1 State StreamK m a
gst (U16HighSurrogate Word16
hi s
st) = do
Step s Word16
r <- State StreamK m Word16 -> s -> m (Step s Word16)
step (State StreamK m a -> State StreamK m Word16
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char))
-> Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a b. (a -> b) -> a -> b
$
case Step s Word16
r of
Yield Word16
x s
st1
| Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
0xDC00 Bool -> Bool -> Bool
&& Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
0xDFFF ->
Char
-> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. a -> s -> Step s a
Yield (Word16 -> Word16 -> Char
combineSurrogates Word16
hi Word16
x) (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
st1)
| Bool
otherwise ->
let msg :: [Char]
msg = [Char]
prefix
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Invalid subsequent UTF16 word " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
x
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" in state " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
hi
in DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip (DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char)
-> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall a b. (a -> b) -> a -> b
$
[Char]
-> DecodeUtf16WithState Word16 Char s
-> DecodeUtf16WithState Word16 Char s
forall {w} {s}.
[Char]
-> DecodeUtf16WithState w Char s -> DecodeUtf16WithState w Char s
transliterateOrError [Char]
msg (s -> DecodeUtf16WithState Word16 Char s
forall w c s. s -> DecodeUtf16WithState w c s
U16NoSurrogate s
st1)
Skip s
st1 -> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip (Word16 -> s -> DecodeUtf16WithState Word16 Char s
forall w c s. w -> s -> DecodeUtf16WithState w c s
U16HighSurrogate Word16
hi s
st1)
Step s Word16
Stop -> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. s -> Step s a
Skip DecodeUtf16WithState Word16 Char s
forall {w} {s}. DecodeUtf16WithState w Char s
inputUnderflow
step1 State StreamK m a
_ (U16YAndC Char
x DecodeUtf16WithState Word16 Char s
st) = Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char))
-> Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a b. (a -> b) -> a -> b
$ Char
-> DecodeUtf16WithState Word16 Char s
-> Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. a -> s -> Step s a
Yield Char
x DecodeUtf16WithState Word16 Char s
st
step1 State StreamK m a
_ DecodeUtf16WithState Word16 Char s
U16D = Step (DecodeUtf16WithState Word16 Char s) Char
-> m (Step (DecodeUtf16WithState Word16 Char s) Char)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step (DecodeUtf16WithState Word16 Char s) Char
forall s a. Step s a
Stop
{-# INLINE decodeUtf16' #-}
decodeUtf16' :: Monad m => Stream m Word16 -> Stream m Char
decodeUtf16' :: forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16' = CodingFailureMode -> Stream m Word16 -> Stream m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word16 -> Stream m Char
decodeUtf16With CodingFailureMode
ErrorOnCodingFailure
{-# INLINE decodeUtf16 #-}
decodeUtf16 :: Monad m => Stream m Word16 -> Stream m Char
decodeUtf16 :: forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16 = CodingFailureMode -> Stream m Word16 -> Stream m Char
forall (m :: * -> *).
Monad m =>
CodingFailureMode -> Stream m Word16 -> Stream m Char
decodeUtf16With CodingFailureMode
TransliterateCodingFailure
{-# INLINE decodeUtf16le' #-}
decodeUtf16le' :: Monad m => Stream m Word16 -> Stream m Char
decodeUtf16le' :: forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16le' =
Stream m Word16 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16'
#ifdef WORDS_BIGENDIAN
. fmap swapByteOrder
#endif
{-# INLINE decodeUtf16le #-}
decodeUtf16le :: Monad m => Stream m Word16 -> Stream m Char
decodeUtf16le :: forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16le =
Stream m Word16 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word16 -> Stream m Char
decodeUtf16
#ifdef WORDS_BIGENDIAN
. fmap swapByteOrder
#endif
#ifndef __GHCJS__
{-# ANN type FlattenState Fuse #-}
#endif
data FlattenState s
= OuterLoop s !(Maybe (DecodeState, CodePoint))
| InnerLoopDecodeInit s MutByteArray !Int !Int
| InnerLoopDecodeFirst s MutByteArray !Int !Int Word8
| InnerLoopDecoding s MutByteArray !Int !Int
!DecodeState !CodePoint
| YAndC !Char (FlattenState s)
| D
{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
decodeUtf8ArraysWithD ::
MonadIO m
=> CodingFailureMode
-> D.Stream m (Array Word8)
-> D.Stream m Char
decodeUtf8ArraysWithD :: forall (m :: * -> *).
MonadIO m =>
CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
decodeUtf8ArraysWithD CodingFailureMode
cfm (D.Stream State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step s
state) =
(State StreamK m Char
-> FlattenState s -> m (Step (FlattenState s) Char))
-> FlattenState s -> Stream m Char
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream (Ptr Word8
-> State StreamK m Char
-> FlattenState s
-> m (Step (FlattenState s) Char)
forall {m :: * -> *} {a}.
Ptr Word8
-> State StreamK m a
-> FlattenState s
-> m (Step (FlattenState s) Char)
step' Ptr Word8
utf8d) (s -> Maybe (Word8, Int) -> FlattenState s
forall s. s -> Maybe (Word8, Int) -> FlattenState s
OuterLoop s
state Maybe (Word8, Int)
forall a. Maybe a
Nothing)
where
{-# INLINE transliterateOrError #-}
transliterateOrError :: [Char] -> FlattenState s -> FlattenState s
transliterateOrError [Char]
e FlattenState s
s =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure -> [Char] -> FlattenState s
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
e
CodingFailureMode
TransliterateCodingFailure -> Char -> FlattenState s -> FlattenState s
forall s. Char -> FlattenState s -> FlattenState s
YAndC Char
replacementChar FlattenState s
s
CodingFailureMode
DropOnCodingFailure -> FlattenState s
s
{-# INLINE inputUnderflow #-}
inputUnderflow :: FlattenState s
inputUnderflow =
case CodingFailureMode
cfm of
CodingFailureMode
ErrorOnCodingFailure ->
[Char] -> FlattenState s
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> FlattenState s) -> [Char] -> FlattenState s
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
"Streamly.Internal.Data.Stream."
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"decodeUtf8ArraysWith: Input Underflow"
CodingFailureMode
TransliterateCodingFailure -> Char -> FlattenState s -> FlattenState s
forall s. Char -> FlattenState s -> FlattenState s
YAndC Char
replacementChar FlattenState s
forall s. FlattenState s
D
CodingFailureMode
DropOnCodingFailure -> FlattenState s
forall s. FlattenState s
D
{-# INLINE_LATE step' #-}
step' :: Ptr Word8
-> State StreamK m a
-> FlattenState s
-> m (Step (FlattenState s) Char)
step' Ptr Word8
_ State StreamK m a
gst (OuterLoop s
st Maybe (Word8, Int)
Nothing) = do
Step s (Array Word8)
r <- State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step (State StreamK m a -> State StreamK m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$
case Step s (Array Word8)
r of
Yield Array {Int
MutByteArray
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
..} s
s ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (s -> MutByteArray -> Int -> Int -> FlattenState s
forall s. s -> MutByteArray -> Int -> Int -> FlattenState s
InnerLoopDecodeInit s
s MutByteArray
arrContents Int
arrStart Int
arrEnd)
Skip s
s -> FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (s -> Maybe (Word8, Int) -> FlattenState s
forall s. s -> Maybe (Word8, Int) -> FlattenState s
OuterLoop s
s Maybe (Word8, Int)
forall a. Maybe a
Nothing)
Step s (Array Word8)
Stop -> FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip FlattenState s
forall s. FlattenState s
D
step' Ptr Word8
_ State StreamK m a
gst (OuterLoop s
st dst :: Maybe (Word8, Int)
dst@(Just (Word8
ds, Int
cp))) = do
Step s (Array Word8)
r <- State StreamK m (Array Word8) -> s -> m (Step s (Array Word8))
step (State StreamK m a -> State StreamK m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$
case Step s (Array Word8)
r of
Yield Array {Int
MutByteArray
arrContents :: forall a. Array a -> MutByteArray
arrStart :: forall a. Array a -> Int
arrEnd :: forall a. Array a -> Int
arrContents :: MutByteArray
arrStart :: Int
arrEnd :: Int
..} s
s ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
forall s.
s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
InnerLoopDecoding s
s MutByteArray
arrContents Int
arrStart Int
arrEnd Word8
ds Int
cp)
Skip s
s -> FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (s -> Maybe (Word8, Int) -> FlattenState s
forall s. s -> Maybe (Word8, Int) -> FlattenState s
OuterLoop s
s Maybe (Word8, Int)
dst)
Step s (Array Word8)
Stop -> FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip FlattenState s
forall s. FlattenState s
inputUnderflow
step' Ptr Word8
_ State StreamK m a
_ (InnerLoopDecodeInit s
st MutByteArray
_ Int
p Int
end)
| Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end = do
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$ FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$ s -> Maybe (Word8, Int) -> FlattenState s
forall s. s -> Maybe (Word8, Int) -> FlattenState s
OuterLoop s
st Maybe (Word8, Int)
forall a. Maybe a
Nothing
step' Ptr Word8
_ State StreamK m a
_ (InnerLoopDecodeInit s
st MutByteArray
contents Int
p Int
end) = do
Word8
x <- IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO Word8
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
contents
case Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
0x7f of
Bool
False ->
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$ FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$ Char -> FlattenState s -> FlattenState s
forall s. Char -> FlattenState s -> FlattenState s
YAndC
(Int -> Char
unsafeChr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x))
(s -> MutByteArray -> Int -> Int -> FlattenState s
forall s. s -> MutByteArray -> Int -> Int -> FlattenState s
InnerLoopDecodeInit s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end)
Bool
True -> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$ FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$ s -> MutByteArray -> Int -> Int -> Word8 -> FlattenState s
forall s.
s -> MutByteArray -> Int -> Int -> Word8 -> FlattenState s
InnerLoopDecodeFirst s
st MutByteArray
contents Int
p Int
end Word8
x
step' Ptr Word8
table State StreamK m a
_ (InnerLoopDecodeFirst s
st MutByteArray
contents Int
p Int
end Word8
x) = do
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Tuple' Word8 Int
decode0 Ptr Word8
table Word8
x
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$
case Word8
sv of
Word8
12 ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$
[Char] -> FlattenState s -> FlattenState s
forall {s}. [Char] -> FlattenState s -> FlattenState s
transliterateOrError
(
[Char]
"Streamly.Internal.Data.Stream."
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"decodeUtf8ArraysWith: Invalid UTF8"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" codepoint encountered"
)
(s -> MutByteArray -> Int -> Int -> FlattenState s
forall s. s -> MutByteArray -> Int -> Int -> FlattenState s
InnerLoopDecodeInit s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end)
Word8
0 -> [Char] -> Step (FlattenState s) Char
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"unreachable state"
Word8
_ -> FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
forall s.
s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
InnerLoopDecoding s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end Word8
sv Int
cp)
step' Ptr Word8
_ State StreamK m a
_ (InnerLoopDecoding s
st MutByteArray
_ Int
p Int
end Word8
sv Int
cp)
| Int
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end = Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$ FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$ s -> Maybe (Word8, Int) -> FlattenState s
forall s. s -> Maybe (Word8, Int) -> FlattenState s
OuterLoop s
st ((Word8, Int) -> Maybe (Word8, Int)
forall a. a -> Maybe a
Just (Word8
sv, Int
cp))
step' Ptr Word8
table State StreamK m a
_ (InnerLoopDecoding s
st MutByteArray
contents Int
p Int
end Word8
statePtr Int
codepointPtr) = do
Word8
x <- IO Word8 -> m Word8
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO Word8
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
p MutByteArray
contents
let (Tuple' Word8
sv Int
cp) = Ptr Word8 -> Word8 -> Int -> Word8 -> Tuple' Word8 Int
decode1 Ptr Word8
table Word8
statePtr Int
codepointPtr Word8
x
Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$
case Word8
sv of
Word8
0 ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$
Char -> FlattenState s -> FlattenState s
forall s. Char -> FlattenState s -> FlattenState s
YAndC
(Int -> Char
unsafeChr Int
cp)
(s -> MutByteArray -> Int -> Int -> FlattenState s
forall s. s -> MutByteArray -> Int -> Int -> FlattenState s
InnerLoopDecodeInit s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end)
Word8
12 ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip (FlattenState s -> Step (FlattenState s) Char)
-> FlattenState s -> Step (FlattenState s) Char
forall a b. (a -> b) -> a -> b
$
[Char] -> FlattenState s -> FlattenState s
forall {s}. [Char] -> FlattenState s -> FlattenState s
transliterateOrError
(
[Char]
"Streamly.Internal.Data.Stream."
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"decodeUtf8ArraysWith: Invalid UTF8"
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" codepoint encountered"
)
(s -> MutByteArray -> Int -> Int -> FlattenState s
forall s. s -> MutByteArray -> Int -> Int -> FlattenState s
InnerLoopDecodeInit s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end)
Word8
_ ->
FlattenState s -> Step (FlattenState s) Char
forall s a. s -> Step s a
Skip
(s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
forall s.
s -> MutByteArray -> Int -> Int -> Word8 -> Int -> FlattenState s
InnerLoopDecoding s
st MutByteArray
contents (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
end Word8
sv Int
cp)
step' Ptr Word8
_ State StreamK m a
_ (YAndC Char
c FlattenState s
s) = Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s) Char -> m (Step (FlattenState s) Char))
-> Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a b. (a -> b) -> a -> b
$ Char -> FlattenState s -> Step (FlattenState s) Char
forall s a. a -> s -> Step s a
Yield Char
c FlattenState s
s
step' Ptr Word8
_ State StreamK m a
_ FlattenState s
D = Step (FlattenState s) Char -> m (Step (FlattenState s) Char)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FlattenState s) Char
forall s a. Step s a
Stop
{-# INLINE decodeUtf8Chunks #-}
decodeUtf8Chunks ::
MonadIO m
=> D.Stream m (Array Word8)
-> D.Stream m Char
decodeUtf8Chunks :: forall (m :: * -> *).
MonadIO m =>
Stream m (Array Word8) -> Stream m Char
decodeUtf8Chunks = CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
forall (m :: * -> *).
MonadIO m =>
CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
decodeUtf8ArraysWithD CodingFailureMode
TransliterateCodingFailure
{-# INLINE decodeUtf8Chunks' #-}
decodeUtf8Chunks' ::
MonadIO m
=> D.Stream m (Array Word8)
-> D.Stream m Char
decodeUtf8Chunks' :: forall (m :: * -> *).
MonadIO m =>
Stream m (Array Word8) -> Stream m Char
decodeUtf8Chunks' = CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
forall (m :: * -> *).
MonadIO m =>
CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
decodeUtf8ArraysWithD CodingFailureMode
ErrorOnCodingFailure
{-# INLINE decodeUtf8Chunks_ #-}
decodeUtf8Chunks_ ::
MonadIO m
=> D.Stream m (Array Word8)
-> D.Stream m Char
decodeUtf8Chunks_ :: forall (m :: * -> *).
MonadIO m =>
Stream m (Array Word8) -> Stream m Char
decodeUtf8Chunks_ = CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
forall (m :: * -> *).
MonadIO m =>
CodingFailureMode -> Stream m (Array Word8) -> Stream m Char
decodeUtf8ArraysWithD CodingFailureMode
DropOnCodingFailure
data WList a = WCons !a !(WList a) | WNil
{-# INLINE ord2 #-}
ord2 :: Char -> (WList Word8)
ord2 :: Char -> WList Word8
ord2 Char
c = Bool -> WList Word8 -> WList Word8
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x80 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x07ff) (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x1 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x2 WList Word8
forall a. WList a
WNil))
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xC0
x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE ord3 #-}
ord3 :: Char -> (WList Word8)
ord3 :: Char -> WList Word8
ord3 Char
c = Bool -> WList Word8 -> WList Word8
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x0800 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xffff) (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x1 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x2 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x3 WList Word8
forall a. WList a
WNil)))
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xE0
x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
x3 :: Word8
x3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE ord4 #-}
ord4 :: Char -> (WList Word8)
ord4 :: Char -> WList Word8
ord4 Char
c = Bool -> WList Word8 -> WList Word8
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x10000) (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x1 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x2 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x3 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
x4 WList Word8
forall a. WList a
WNil))))
where
n :: Int
n = Char -> Int
ord Char
c
x1 :: Word8
x1 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
18) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0xF0
x2 :: Word8
x2 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
x3 :: Word8
x3 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ ((Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
x4 :: Word8
x4 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3F) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
0x80
{-# INLINE_NORMAL readCharUtf8With #-}
readCharUtf8With :: Monad m => (WList Word8) -> Unfold m Char Word8
readCharUtf8With :: forall (m :: * -> *). Monad m => WList Word8 -> Unfold m Char Word8
readCharUtf8With WList Word8
surr = (WList Word8 -> m (Step (WList Word8) Word8))
-> (Char -> m (WList Word8)) -> Unfold m Char Word8
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold WList Word8 -> m (Step (WList Word8) Word8)
forall {m :: * -> *} {a}.
Monad m =>
WList a -> m (Step (WList a) a)
step Char -> m (WList Word8)
forall {m :: * -> *}. Monad m => Char -> m (WList Word8)
inject
where
inject :: Char -> m (WList Word8)
inject Char
c =
WList Word8 -> m (WList Word8)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WList Word8 -> m (WList Word8)) -> WList Word8 -> m (WList Word8)
forall a b. (a -> b) -> a -> b
$ case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7F -> Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
`WCons` WList Word8
forall a. WList a
WNil
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x7FF -> Char -> WList Word8
ord2 Char
c
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF -> if Char -> Bool
isSurrogate Char
c then WList Word8
surr else Char -> WList Word8
ord3 Char
c
| Bool
otherwise -> Char -> WList Word8
ord4 Char
c
{-# INLINE_LATE step #-}
step :: WList a -> m (Step (WList a) a)
step WList a
WNil = Step (WList a) a -> m (Step (WList a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (WList a) a
forall s a. Step s a
Stop
step (WCons a
x WList a
xs) = Step (WList a) a -> m (Step (WList a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WList a) a -> m (Step (WList a) a))
-> Step (WList a) a -> m (Step (WList a) a)
forall a b. (a -> b) -> a -> b
$ a -> WList a -> Step (WList a) a
forall s a. a -> s -> Step s a
Yield a
x WList a
xs
{-# INLINE_NORMAL readCharUtf8' #-}
readCharUtf8' :: Monad m => Unfold m Char Word8
readCharUtf8' :: forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8' =
WList Word8 -> Unfold m Char Word8
forall (m :: * -> *). Monad m => WList Word8 -> Unfold m Char Word8
readCharUtf8With (WList Word8 -> Unfold m Char Word8)
-> WList Word8 -> Unfold m Char Word8
forall a b. (a -> b) -> a -> b
$
[Char] -> WList Word8
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
{-# INLINE_NORMAL encodeUtf8D' #-}
encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8
encodeUtf8D' :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D' = Unfold m Char Word8 -> Stream m Char -> Stream m Word8
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldEach Unfold m Char Word8
forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8'
{-# INLINE encodeUtf8' #-}
encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8
encodeUtf8' :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8' = Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D'
{-# INLINE_NORMAL readCharUtf8 #-}
readCharUtf8 :: Monad m => Unfold m Char Word8
readCharUtf8 :: forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8 = WList Word8 -> Unfold m Char Word8
forall (m :: * -> *). Monad m => WList Word8 -> Unfold m Char Word8
readCharUtf8With (WList Word8 -> Unfold m Char Word8)
-> WList Word8 -> Unfold m Char Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
239 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
191 (Word8 -> WList Word8 -> WList Word8
forall a. a -> WList a -> WList a
WCons Word8
189 WList Word8
forall a. WList a
WNil))
{-# INLINE_NORMAL encodeUtf8D #-}
encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8
encodeUtf8D :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D = Unfold m Char Word8 -> Stream m Char -> Stream m Word8
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldEach Unfold m Char Word8
forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8
{-# INLINE encodeUtf8 #-}
encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
encodeUtf8 :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8 = Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D
{-# INLINE_NORMAL readCharUtf8_ #-}
readCharUtf8_ :: Monad m => Unfold m Char Word8
readCharUtf8_ :: forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8_ = WList Word8 -> Unfold m Char Word8
forall (m :: * -> *). Monad m => WList Word8 -> Unfold m Char Word8
readCharUtf8With WList Word8
forall a. WList a
WNil
{-# INLINE_NORMAL encodeUtf8D_ #-}
encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8
encodeUtf8D_ :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D_ = Unfold m Char Word8 -> Stream m Char -> Stream m Word8
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldEach Unfold m Char Word8
forall (m :: * -> *). Monad m => Unfold m Char Word8
readCharUtf8_
{-# INLINE encodeUtf8_ #-}
encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8
encodeUtf8_ :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8_ = Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8D_
{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
{-# INLINE encodeUtf8Lax #-}
encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8
encodeUtf8Lax :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8Lax = Stream m Char -> Stream m Word8
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word8
encodeUtf8
{-# INLINE utf16LowSurrogate #-}
utf16LowSurrogate :: Word16
utf16LowSurrogate :: Word16
utf16LowSurrogate = Word16
0xDC00
{-# INLINE utf16HighSurrogate #-}
utf16HighSurrogate :: Word16
utf16HighSurrogate :: Word16
utf16HighSurrogate = Word16
0xD800
{-# INLINE_NORMAL readCharUtf16With #-}
readCharUtf16With :: Monad m => WList Word16 -> Unfold m Char Word16
readCharUtf16With :: forall (m :: * -> *).
Monad m =>
WList Word16 -> Unfold m Char Word16
readCharUtf16With WList Word16
invalidReplacement = (WList Word16 -> m (Step (WList Word16) Word16))
-> (Char -> m (WList Word16)) -> Unfold m Char Word16
forall (m :: * -> *) a b s.
(s -> m (Step s b)) -> (a -> m s) -> Unfold m a b
Unfold WList Word16 -> m (Step (WList Word16) Word16)
forall {m :: * -> *} {a}.
Monad m =>
WList a -> m (Step (WList a) a)
step Char -> m (WList Word16)
forall {m :: * -> *}. Monad m => Char -> m (WList Word16)
inject
where
inject :: Char -> m (WList Word16)
inject Char
c =
WList Word16 -> m (WList Word16)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WList Word16 -> m (WList Word16))
-> WList Word16 -> m (WList Word16)
forall a b. (a -> b) -> a -> b
$ case Char -> Int
ord Char
c of
Int
x | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0xD800 -> Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Word16 -> WList Word16 -> WList Word16
forall a. a -> WList a -> WList a
`WCons` WList Word16
forall a. WList a
WNil
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xDFFF Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF -> Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Word16 -> WList Word16 -> WList Word16
forall a. a -> WList a -> WList a
`WCons` WList Word16
forall a. WList a
WNil
| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x10000 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF ->
let u :: Int
u = Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
0x10000
h :: Word16
h = Word16
utf16HighSurrogate
Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
u Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
10)
l :: Word16
l = Word16
utf16LowSurrogate
Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
u Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x3FF)
in Word16 -> WList Word16 -> WList Word16
forall a. a -> WList a -> WList a
WCons Word16
h (WList Word16 -> WList Word16) -> WList Word16 -> WList Word16
forall a b. (a -> b) -> a -> b
$ Word16 -> WList Word16 -> WList Word16
forall a. a -> WList a -> WList a
WCons Word16
l WList Word16
forall a. WList a
WNil
| Bool
otherwise -> WList Word16
invalidReplacement
{-# INLINE_LATE step #-}
step :: WList a -> m (Step (WList a) a)
step WList a
WNil = Step (WList a) a -> m (Step (WList a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (WList a) a
forall s a. Step s a
Stop
step (WCons a
x WList a
xs) = Step (WList a) a -> m (Step (WList a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WList a) a -> m (Step (WList a) a))
-> Step (WList a) a -> m (Step (WList a) a)
forall a b. (a -> b) -> a -> b
$ a -> WList a -> Step (WList a) a
forall s a. a -> s -> Step s a
Yield a
x WList a
xs
{-# INLINE encodeUtf16' #-}
encodeUtf16' :: Monad m => Stream m Char -> Stream m Word16
encodeUtf16' :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16' = Unfold m Char Word16 -> Stream m Char -> Stream m Word16
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldEach (WList Word16 -> Unfold m Char Word16
forall (m :: * -> *).
Monad m =>
WList Word16 -> Unfold m Char Word16
readCharUtf16With WList Word16
forall {a}. a
errString)
where
errString :: a
errString =
[Char] -> a
forall a. (?callStack::CallStack) => [Char] -> a
error
([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ "Streamly.Internal.Unicode.encodeUtf16': Encountered an \
invalid character"
{-# INLINE encodeUtf16 #-}
encodeUtf16 :: Monad m => Stream m Char -> Stream m Word16
encodeUtf16 :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16 = Unfold m Char Word16 -> Stream m Char -> Stream m Word16
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldEach (WList Word16 -> Unfold m Char Word16
forall (m :: * -> *).
Monad m =>
WList Word16 -> Unfold m Char Word16
readCharUtf16With WList Word16
forall a. WList a
WNil)
{-# INLINE encodeUtf16le' #-}
encodeUtf16le' :: Monad m => Stream m Char -> Stream m Word16
encodeUtf16le' :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16le' =
#ifdef WORDS_BIGENDIAN
fmap swapByteOrder .
#endif
Stream m Char -> Stream m Word16
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16'
{-# INLINE encodeUtf16le #-}
encodeUtf16le :: Monad m => Stream m Char -> Stream m Word16
encodeUtf16le :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16le =
#ifdef WORDS_BIGENDIAN
fmap swapByteOrder .
#endif
Stream m Char -> Stream m Word16
forall (m :: * -> *). Monad m => Stream m Char -> Stream m Word16
encodeUtf16
{-# INLINE fromStr# #-}
fromStr# :: MonadIO m => Addr# -> Stream m Char
fromStr# :: forall (m :: * -> *). MonadIO m => Addr# -> Stream m Char
fromStr# Addr#
addr = Stream m Word8 -> Stream m Char
forall (m :: * -> *). Monad m => Stream m Word8 -> Stream m Char
decodeUtf8 (Stream m Word8 -> Stream m Char)
-> Stream m Word8 -> Stream m Char
forall a b. (a -> b) -> a -> b
$ Addr# -> Stream m Word8
forall (m :: * -> *). Monad m => Addr# -> Stream m Word8
Stream.fromCString# Addr#
addr
{-# INLINE encodeObject #-}
encodeObject :: MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char
-> a
-> m (Array Word8)
encodeObject :: forall (m :: * -> *) a.
MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char -> a -> m (Array Word8)
encodeObject Stream m Char -> Stream m Word8
encode Unfold m a Char
u = Fold m Word8 (Array Word8) -> Stream m Word8 -> m (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
Stream.fold Fold m Word8 (Array Word8)
forall (m :: * -> *) a. (MonadIO m, Unbox a) => Fold m a (Array a)
Array.create (Stream m Word8 -> m (Array Word8))
-> (a -> Stream m Word8) -> a -> m (Array Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stream m Char -> Stream m Word8
encode (Stream m Char -> Stream m Word8)
-> (a -> Stream m Char) -> a -> Stream m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unfold m a Char -> a -> Stream m Char
forall (m :: * -> *) a b.
Applicative m =>
Unfold m a b -> a -> Stream m b
Stream.unfold Unfold m a Char
u
{-# INLINE encodeObjects #-}
encodeObjects :: MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char
-> Stream m a
-> Stream m (Array Word8)
encodeObjects :: forall (m :: * -> *) a.
MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char -> Stream m a -> Stream m (Array Word8)
encodeObjects Stream m Char -> Stream m Word8
encode Unfold m a Char
u = (a -> m (Array Word8)) -> Stream m a -> Stream m (Array Word8)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Stream m a -> Stream m b
Stream.mapM ((Stream m Char -> Stream m Word8)
-> Unfold m a Char -> a -> m (Array Word8)
forall (m :: * -> *) a.
MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char -> a -> m (Array Word8)
encodeObject Stream m Char -> Stream m Word8
encode Unfold m a Char
u)
{-# INLINE encodeStrings #-}
encodeStrings :: MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Stream m String
-> Stream m (Array Word8)
encodeStrings :: forall (m :: * -> *).
MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Stream m [Char] -> Stream m (Array Word8)
encodeStrings Stream m Char -> Stream m Word8
encode = (Stream m Char -> Stream m Word8)
-> Unfold m [Char] Char
-> Stream m [Char]
-> Stream m (Array Word8)
forall (m :: * -> *) a.
MonadIO m =>
(Stream m Char -> Stream m Word8)
-> Unfold m a Char -> Stream m a -> Stream m (Array Word8)
encodeObjects Stream m Char -> Stream m Word8
encode Unfold m [Char] Char
forall (m :: * -> *) a. Applicative m => Unfold m [a] a
Unfold.fromList
{-# INLINE stripHead #-}
stripHead :: Monad m => Stream m Char -> Stream m Char
stripHead :: forall (m :: * -> *). Monad m => Stream m Char -> Stream m Char
stripHead = (Char -> Bool) -> Stream m Char -> Stream m Char
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Stream m a -> Stream m a
Stream.dropWhile Char -> Bool
isSpace
{-# INLINE lines #-}
lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
lines :: forall (m :: * -> *) b.
Monad m =>
Fold m Char b -> Stream m Char -> Stream m b
lines Fold m Char b
f = Fold m Char b -> Stream m Char -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> Stream m b
Stream.foldMany ((Char -> Bool) -> Fold m Char b -> Fold m Char b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
Fold.takeEndBy_ (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Fold m Char b
f)
#if !MIN_VERSION_base(4,17,0)
foreign import ccall unsafe "u_iswspace"
iswspace :: Int -> Int
#endif
{-# INLINE isSpace #-}
isSpace :: Char -> Bool
isSpace :: Char -> Bool
isSpace Char
c
| Word
uc Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x377 = Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
32 Bool -> Bool -> Bool
|| Word
uc Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
0x9 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
4 Bool -> Bool -> Bool
|| Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0xa0
#if MIN_VERSION_base(4,17,0)
| Bool
otherwise = Char -> GeneralCategory
generalCategory Char
c GeneralCategory -> GeneralCategory -> Bool
forall a. Eq a => a -> a -> Bool
== GeneralCategory
Space
#else
| otherwise = iswspace (ord c) /= 0
#endif
where
uc :: Word
uc = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word
{-# INLINE words #-}
words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
words :: forall (m :: * -> *) b.
Monad m =>
Fold m Char b -> Stream m Char -> Stream m b
words Fold m Char b
f = (Char -> Bool) -> Fold m Char b -> Stream m Char -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
D.wordsBy Char -> Bool
isSpace Fold m Char b
f
{-# INLINE unlines #-}
unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
unlines :: forall (m :: * -> *) a.
MonadIO m =>
Unfold m a Char -> Stream m a -> Stream m Char
unlines = Char -> Unfold m a Char -> Stream m a -> Stream m Char
forall (m :: * -> *) c b.
Monad m =>
c -> Unfold m b c -> Stream m b -> Stream m c
Stream.unfoldEachEndBy Char
'\n'
{-# INLINE unwords #-}
unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
unwords :: forall (m :: * -> *) a.
MonadIO m =>
Unfold m a Char -> Stream m a -> Stream m Char
unwords = Char -> Unfold m a Char -> Stream m a -> Stream m Char
forall (m :: * -> *) c b.
Monad m =>
c -> Unfold m b c -> Stream m b -> Stream m c
Stream.unfoldEachSepBy Char
' '