3544b94 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add decodeUtf8ArraysLenient, strictify fields in encodeUtf8.

3544b94Pranay Sashank7 years ago

src/Streamly/Data/String.hs+7

compare with master

unifiedsplit

@@ -53,6 +53,7 @@ module Streamly.Data.String

53 , decodeUtf8

54 , decodeUtf8Lenient

55 , decodeUtf8Arrays

56+ , decodeUtf8ArraysLenient

57 -- * Elimination (Encoding)

58 -- * Elimination (Encoding)

58 , encodeChar8

59 , encodeChar8

@@ -156,6 +157,12 @@ decodeUtf8Arrays = D.fromStreamD . D.decodeUtf8Arrays . D.toStreamD

156decodeUtf8Lenient :: (Monad m, IsStream t) => t m Word8 -> t m Char

157decodeUtf8Lenient :: (Monad m, IsStream t) => t m Word8 -> t m Char

157decodeUtf8Lenient = D.fromStreamD . D.decodeUtf8Lenient . D.toStreamD

158decodeUtf8Lenient = D.fromStreamD . D.decodeUtf8Lenient . D.toStreamD

158

159

160+{-# INLINE decodeUtf8ArraysLenient #-}

161+decodeUtf8ArraysLenient ::

162+ (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char

163+decodeUtf8ArraysLenient =

164+ D.fromStreamD . D.decodeUtf8ArraysLenient . D.toStreamD

165+

159-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

166-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

160{-# INLINE encodeUtf8 #-}

167{-# INLINE encodeUtf8 #-}

161encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

168encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

src/Streamly/Memory/Array/Types.hs+1−1

@@ -668,7 +668,7 @@ fromStreamDArraysOf n (D.Stream step state) =

668-- a custom way to concat arrays.

669data FlattenState s a =

670 OuterLoop s

671− | InnerLoop s (ForeignPtr a) (Ptr a) (Ptr a)

671+ | InnerLoop s !(ForeignPtr a) !(Ptr a) !(Ptr a)

672

673{-# INLINE_NORMAL flattenArrays #-}

674flattenArrays :: forall m a. (MonadIO m, Storable a)

src/Streamly/Streams/StreamD.hs+157−283

@@ -266,6 +266,7 @@ module Streamly.Streams.StreamD

266 , encodeUtf8

267 , decodeUtf8Lenient

268 , decodeUtf8Arrays

269+ , decodeUtf8ArraysLenient

269 )

270 )

270where

271where

271

272

@@ -282,8 +283,7 @@ import Data.Maybe (fromJust, isJust)

282import Data.Word (Word32)

283import Data.Word (Word32)

283import Foreign.Ptr (Ptr)

284import Foreign.Ptr (Ptr)

284import Foreign.Storable (Storable(..))

285import Foreign.Storable (Storable(..))

285−import GHC.Base (assert, Char(..), unsafeChr, (-#), (+#), uncheckedIShiftL#,

286+import GHC.Base (assert, Char(..), unsafeChr, ord)

286− word2Int#, chr#, ord)

287import GHC.IO.Encoding.Failure (isSurrogate)

288import GHC.Types (SPEC(..))

289import GHC.Word (Word8(..))

@@ -301,6 +301,7 @@ import Streamly.Fold.Types (Fold(..))

301import Streamly.Pipe.Types (Pipe(..), PipeState(..))

302import Streamly.SVar (MonadAsync, defState, adaptState)

303import Streamly.Unfold.Types (Unfold(..))

304+import Streamly.Strict (Tuple'(..))

304

305

305import Streamly.Streams.StreamD.Type

306import Streamly.Streams.StreamD.Type

306

307

@@ -312,7 +313,6 @@ import qualified Streamly.Streams.StreamK as K

312import Foreign.Ptr (plusPtr)

313import Foreign.Ptr (plusPtr)

313import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

314import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

314import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)

315import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)

315−import Data.Array.Unboxed (UArray, listArray, (!))

316

317------------------------------------------------------------------------------

318-- Construction

@@ -2973,16 +2973,16 @@ the (Stream step state) = go state

2973-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.

2974

2975{-# INLINE ord2 #-}

2976−ord2 :: Char -> [Word8]

2976+ord2 :: Char -> WList

2977−ord2 c = assert (n >= 0x80 && n <= 0x07ff) [x1, x2]

2977+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))

2978 where

2979 n = ord c

2980 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

2981 x2 = fromIntegral $ (n .&. 0x3F) + 0x80

2982

2983{-# INLINE ord3 #-}

2984−ord3 :: Char -> [Word8]

2984+ord3 :: Char -> WList

2985−ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]

2985+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))

2986 where

2987 n = ord c

2988 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0

@@ -2990,8 +2990,8 @@ ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]

2990 x3 = fromIntegral $ (n .&. 0x3F) + 0x80

2991

2992{-# INLINE ord4 #-}

2993−ord4 :: Char -> [Word8]

2993+ord4 :: Char -> WList

2994−ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]

2994+ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))

2995 where

2996 n = ord c

2997 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0

@@ -2999,245 +2999,20 @@ ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]

2999 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

3000 x4 = fromIntegral $ (n .&. 0x3F) + 0x80

3001

3002−{-# INLINE chr2 #-}

3003−chr2 :: Word8 -> Word8 -> Char

3004−chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

3005− where

3006− !y1# = word2Int# x1#

3007− !y2# = word2Int# x2#

3008− !z1# = uncheckedIShiftL# (y1# -# 192#) 6#

3009− !z2# = y2# -# 128#

3010−

3011−{-# INLINE chr3 #-}

3012−chr3 :: Word8 -> Word8 -> Word8 -> Char

3013−chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))

3014− where

3015− !y1# = word2Int# x1#

3016− !y2# = word2Int# x2#

3017− !y3# = word2Int# x3#

3018− !z1# = uncheckedIShiftL# (y1# -# 224#) 12#

3019− !z2# = uncheckedIShiftL# (y2# -# 128#) 6#

3020− !z3# = y3# -# 128#

3021−

3022−{-# INLINE chr4 #-}

3023−chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char

3024−chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =

3025− C# (chr# (z1# +# z2# +# z3# +# z4#))

3026− where

3027− !y1# = word2Int# x1#

3028− !y2# = word2Int# x2#

3029− !y3# = word2Int# x3#

3030− !y4# = word2Int# x4#

3031− !z1# = uncheckedIShiftL# (y1# -# 240#) 18#

3032− !z2# = uncheckedIShiftL# (y2# -# 128#) 12#

3033− !z3# = uncheckedIShiftL# (y3# -# 128#) 6#

3034− !z4# = y4# -# 128#

3035−

3036−{-# INLINE between #-}

3037−between ::

3038− Word8 -- ^ byte to check

3039− -> Word8 -- ^ lower bound

3040− -> Word8 -- ^ upper bound

3041− -> Bool

3042−between x y z = x >= y && x <= z

3043−

3044−{-# INLINE validate3 #-}

3045−validate3 :: Word8 -> Word8 -> Word8 -> Bool

3046−validate3 x1 x2 x3 = validate3_1 ||

3047− validate3_2 ||

3048− validate3_3 ||

3049− validate3_4

3050− where

3051− validate3_1 = (x1 == 0xE0) &&

3052− between x2 0xA0 0xBF &&

3053− between x3 0x80 0xBF

3054− validate3_2 = between x1 0xE1 0xEC &&

3055− between x2 0x80 0xBF &&

3056− between x3 0x80 0xBF

3057− validate3_3 = x1 == 0xED &&

3058− between x2 0x80 0x9F &&

3059− between x3 0x80 0xBF

3060− validate3_4 = between x1 0xEE 0xEF &&

3061− between x2 0x80 0xBF &&

3062− between x3 0x80 0xBF

3063−

3064−{-# INLINE validate4 #-}

3065−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

3066−validate4 x1 x2 x3 x4 = validate4_1 ||

3067− validate4_2 ||

3068− validate4_3

3069− where

3070− validate4_1 = x1 == 0xF0 &&

3071− between x2 0x90 0xBF &&

3072− between x3 0x80 0xBF &&

3073− between x4 0x80 0xBF

3074− validate4_2 = between x1 0xF1 0xF3 &&

3075− between x2 0x80 0xBF &&

3076− between x3 0x80 0xBF &&

3077− between x4 0x80 0xBF

3078− validate4_3 = x1 == 0xF4 &&

3079− between x2 0x80 0x8F &&

3080− between x3 0x80 0xBF &&

3081− between x4 0x80 0xBF

3082−

3083−data CPoint s

3084− = FreshPoint s

3085− | Two !Word8 s

3086− | GoThree !Word8 s

3087− | Three !Word8 !Word8 s

3088− | GoFour !Word8 s

3089− | Four1 !Word8 !Word8 s

3090− | Four !Word8 !Word8 !Word8 s

3091− | YieldAndContinue !Char (CPoint s)

3092− | Done

3093−

3094data CodingFailureMode

3002data CodingFailureMode

3095 = TransliterateCodingFailure

3003 = TransliterateCodingFailure

3096 | ErrorOnCodingFailure

3004 | ErrorOnCodingFailure

3097 deriving (Show)

3005 deriving (Show)

3098

3006

3099−{-# INLINE_NORMAL decodeUtf8With #-}

3007+{-# INLINE replacementChar #-}

3100−decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char

3008+replacementChar :: Char

3101−decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint state)

3009+replacementChar = '\xFFFD'

3102− where

3103− {-# INLINE transliterateOrError #-}

3104− transliterateOrError e s =

3105− case cfm of

3106− ErrorOnCodingFailure -> error e

3107− TransliterateCodingFailure -> Skip $ YieldAndContinue '\xFFFD' (FreshPoint s)

3108− {-# INLINE inputUnderflow #-}

3109− inputUnderflow = case cfm of

3110− ErrorOnCodingFailure -> error "Input Underflow"

3111− TransliterateCodingFailure -> Skip $ YieldAndContinue '\xFFFD' Done

3112−

3113− {-# INLINE_LATE step' #-}

3114− step' gst (FreshPoint st) = do

3115− r <- step (adaptState gst) st

3116− return $

3117− case r of

3118− Yield c0 s

3119− | c0 <= 0x7f ->

3120− Skip $ YieldAndContinue (unsafeChr (fromIntegral c0)) (FreshPoint s)

3121− | c0 >= 0xc0 && c0 <= 0xc1 ->

3122− transliterateOrError "Invalid Overlong forms" s

3123− | c0 >= 0xc2 && c0 <= 0xdf -> Skip (Two c0 s)

3124− | c0 >= 0xe0 && c0 <= 0xef -> Skip (GoThree c0 s)

3125− | c0 >= 0xf0 -> Skip (GoFour c0 s)

3126− | otherwise -> transliterateOrError "Invalid Sequence" s

3127− Skip s -> Skip (FreshPoint s)

3128− Stop -> Stop

3129−

3130− -- Decoding of a UTF8 character that spans two bytes with one byte (c0)

3131− -- known.

3132− step' gst (Two c0 st) = do

3133− r <- step (adaptState gst) st

3134− return $

3135− case r of

3136− Yield c1 s

3137− | c1 < 0x80 || c1 >= 0xc0 ->

3138− transliterateOrError "Invalid Sequence" s

3139− | otherwise -> Skip $ YieldAndContinue (chr2 c0 c1) (FreshPoint s)

3140− Skip s -> Skip $ Two c0 s

3141− Stop -> inputUnderflow

3142−

3143− -- Decoding of a UTF8 character that spans three bytes with first byte (c0)

3144− -- known.

3145− step' gst (GoThree c0 st) = do

3146− r <- step (adaptState gst) st

3147− return $

3148− case r of

3149− Yield c1 s

3150− | not (validate3 c0 c1 0x80) ->

3151− transliterateOrError "Invalid Sequence" s

3152− -- See #3341@ghc

3153− | otherwise -> Skip $ Three c0 c1 s

3154− Skip s -> Skip $ GoThree c0 s

3155− Stop -> inputUnderflow

3156−

3157− -- Two bytes known of a 3 byte UTF8 encoded unicode character.

3158− step' gst (Three c0 c1 st) = do

3159− r <- step (adaptState gst) st

3160− return $

3161− case r of

3162− Yield c2 s

3163− | not (validate3 c0 c1 c2) ->

3164− transliterateOrError "Invalid Sequence" s

3165− | otherwise -> Skip $ YieldAndContinue (chr3 c0 c1 c2) (FreshPoint s)

3166− Skip s -> Skip $ Three c0 c1 s

3167− Stop -> inputUnderflow

3168−

3169− -- One byte known of a four byte UTF8 unicode character.

3170− step' gst (GoFour c0 st) = do

3171− r <- step (adaptState gst) st

3172− return $

3173− case r of

3174− Yield c1 s

3175− | not (validate4 c0 c1 0x80 0x80) ->

3176− transliterateOrError "Invalid Sequence" s

3177− | otherwise -> Skip $ Four1 c0 c1 s

3178− Skip s -> Skip $ GoFour c0 s

3179− Stop -> inputUnderflow

3180−

3181− -- Two bytes known of a four byte UTF8 unicode character.

3182− step' gst (Four1 c0 c1 st) = do

3183− r <- step (adaptState gst) st

3184− return $

3185− case r of

3186− Yield c2 s

3187− | not (validate4 c0 c1 c2 0x80) ->

3188− transliterateOrError "Invalid Sequence" s

3189− | otherwise -> Skip $ Four c0 c1 c2 s

3190− Skip s -> Skip $ Four1 c0 c1 s

3191− Stop -> inputUnderflow

3192−

3193− -- Three bytes known of a three byte UTF8 unicode character.

3194− step' gst (Four c0 c1 c2 st) = do

3195− r <- step (adaptState gst) st

3196− return $

3197− case r of

3198− Yield c3 s

3199− | not (validate4 c0 c1 c2 c3) ->

3200− transliterateOrError "Invalid Sequence" s

3201− | otherwise -> Skip $ YieldAndContinue (chr4 c0 c1 c2 c3) (FreshPoint s)

3202− Skip s -> Skip $ Four c0 c1 c2 s

3203− Stop -> inputUnderflow

3204−

3205− -- This way so that we only need one Yield.

3206− --step' _ (YieldAndStop c) = return $ Yield c Done

3207− step' _ (YieldAndContinue c s) = return $ Yield c s

3208− step' _ Done = return Stop

3209−

3210−{-# INLINE decodeUtf8Lenient #-}

3211−decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char

3212−decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure

3213−

3214−{-# INLINE_NORMAL encodeUtf8 #-}

3215−encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8

3216−encodeUtf8 (Stream step state) = Stream step' (state, [])

3217− where

3218− {-# INLINE_LATE step' #-}

3219− step' gst (st, []) = do

3220− r <- step (adaptState gst) st

3221− return $

3222− case r of

3223− Yield c s ->

3224− case ord c of

3225− x | x <= 0x7F -> Skip (s, [fromIntegral x])

3226− | x <= 0x7FF -> Skip (s, (ord2 c))

3227− | x <= 0xFFFF ->

3228− if isSurrogate c

3229− then error "Encountered a surrogate"

3230− else Skip (s, (ord3 c))

3231− | otherwise -> Skip (s, (ord4 c))

3232− Skip s -> Skip (s, [])

3233− Stop -> Stop

3234− step' _ (s, (x:xs)) = return $ Yield x (s, xs)

3235

3010

3236type CodePoint = Word32

3011type CodePoint = Word32

3237type DecoderState = Word32

3012type DecoderState = Word32

3238

3013

3239−utf8d :: UArray Word32 Word32

3014+utf8d :: A.Array Word32

3240−utf8d = listArray (0,363) [

3015+utf8d = A.fromList [

3241 -- The first part of the table maps bytes to character classes that

3016 -- The first part of the table maps bytes to character classes that

3242 -- to reduce the size of the transition table and create bitmasks.

3017 -- to reduce the size of the transition table and create bitmasks.

3243 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

3018 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

@@ -3259,50 +3034,109 @@ utf8d = listArray (0,363) [

3259 ]

3034 ]

3260

3035

3261{-# INLINE decode #-}

3036{-# INLINE decode #-}

3262−decode :: (DecoderState, CodePoint) -> Word32 -> (DecoderState, CodePoint)

3037+decode :: DecoderState -> CodePoint -> Word32 -> Tuple' DecoderState CodePoint

3263−decode (state, codep) byte =

3038+decode state codep byte =

3264− let t = utf8d ! byte

3039+ let t = utf8d `A.unsafeIndex` (fromIntegral byte)

3265 codep' =

3040 codep' =

3266 if state /= 0

3041 if state /= 0

3267 then (byte .&. 0x3f) .|. (codep `shiftL` 6)

3042 then (byte .&. 0x3f) .|. (codep `shiftL` 6)

3268 else (0xff `shiftR` (fromIntegral t)) .&. byte

3043 else (0xff `shiftR` (fromIntegral t)) .&. byte

3269− state' = utf8d ! (256 + state + t)

3044+ state' = utf8d `A.unsafeIndex` (fromIntegral $ 256 + state + t)

3270− in (state', codep')

3045+ in (Tuple' state' codep')

3046+

3047+data FreshPoint s

3048+ = FreshPoint !CodePoint !DecoderState s

3049+ | YieldAndContinue !Char (FreshPoint s)

3050+ | Done

3271

3051

3272-- XXX Add proper error messages

3052-- XXX Add proper error messages

3273−{-# INLINE_NORMAL decodeUtf8 #-}

3053+{-# INLINE_NORMAL decodeUtf8With #-}

3274−decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

3054+decodeUtf8With :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char

3275−decodeUtf8 (Stream step state) = Stream step' (0, 0, state)

3055+decodeUtf8With cfm (Stream step state) = Stream step' (FreshPoint 0 0 state)

3276 where

3056 where

3277−

3057+ {-# INLINE transliterateOrError #-}

3058+ transliterateOrError e s =

3059+ case cfm of

3060+ ErrorOnCodingFailure -> error e

3061+ TransliterateCodingFailure -> YieldAndContinue replacementChar s

3062+ {-# INLINE inputUnderflow #-}

3063+ inputUnderflow =

3064+ case cfm of

3065+ ErrorOnCodingFailure ->

3066+ error "Streamly.Streams.StreamD.decodeUtf8With: Input Underflow"

3067+ TransliterateCodingFailure -> YieldAndContinue replacementChar Done

3278 {-# INLINE_LATE step' #-}

3068 {-# INLINE_LATE step' #-}

3279− step' gst (codepointPtr, statePtr, st) = do

3069+ step' gst (FreshPoint codepointPtr statePtr st) = do

3280 r <- step (adaptState gst) st

3070 r <- step (adaptState gst) st

3071+ return $

3281− case r of

3072+ case r of

3282− Yield x s -> do

3073+ Yield x s ->

3074+ let (Tuple' sv cp) =

3283− let (sv, cp) = decode (statePtr, codepointPtr) (fromIntegral x)

3075+ decode statePtr codepointPtr (fromIntegral x)

3284− return $

3285− case sv of

3076+ in case sv of

3286− 12 -> error "UTF8: REJECT"

3077+ 12 ->

3287− 0 ->

3078+ Skip $

3079+ transliterateOrError

3080+ "Streamly.Streams.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"

3081+ (FreshPoint 0 0 st)

3082+ 0 ->

3083+ Skip $

3084+ YieldAndContinue

3288− Yield (unsafeChr (fromIntegral cp)) (cp, sv, s)

3085+ (unsafeChr (fromIntegral cp))

3086+ (FreshPoint cp sv s)

3289− _ -> Skip (cp, sv, s)

3087+ _ -> Skip (FreshPoint cp sv s)

3290− Skip s -> return $ Skip (codepointPtr, statePtr, s)

3088+ Skip s -> Skip (FreshPoint codepointPtr statePtr s)

3291− Stop -> return Stop -- XXX check whether statePtr is in Accept state or not.

3089+ Stop ->

3090+ if statePtr /= 0

3091+ then Skip inputUnderflow

3092+ else Skip Done

3093+ step' _ (YieldAndContinue c s) = return $ Yield c s

3094+ step' _ Done = return Stop

3095+

3096+{-# INLINE decodeUtf8 #-}

3097+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

3098+decodeUtf8 = decodeUtf8With ErrorOnCodingFailure

3099+

3100+{-# INLINE decodeUtf8Lenient #-}

3101+decodeUtf8Lenient :: Monad m => Stream m Word8 -> Stream m Char

3102+decodeUtf8Lenient = decodeUtf8With TransliterateCodingFailure

3292

3103

3293data FlattenState s a

3104data FlattenState s a

3294 = OuterLoop !CodePoint !DecoderState s

3105 = OuterLoop !CodePoint !DecoderState s

3295 | InnerLoop !CodePoint !DecoderState s (ForeignPtr a) (Ptr a) (Ptr a)

3106 | InnerLoop !CodePoint !DecoderState s (ForeignPtr a) (Ptr a) (Ptr a)

3107+ | YAndC !Char (FlattenState s a) -- These constructors can be

3108+ -- encoded in the FreshPoint

3109+ -- type, I prefer to keep these

3110+ -- flat even though that means

3111+ -- coming up with new names

3112+ | D

3296

3113

3297-- The normal decodeUtf8 above should fuse with flattenArrays

3114-- The normal decodeUtf8 above should fuse with flattenArrays

3298-- to create this exact code but it doesn't for some reason, as of now this

3115-- to create this exact code but it doesn't for some reason, as of now this

3299-- remains the fastest way I could figure out to decodeUtf8.

3116-- remains the fastest way I could figure out to decodeUtf8.

3300--

3117--

3301-- XXX Add Proper error messages

3118-- XXX Add Proper error messages

3302−{-# INLINE_NORMAL decodeUtf8Arrays #-}

3119+{-# INLINE_NORMAL decodeUtf8ArraysWith #-}

3120+decodeUtf8ArraysWith ::

3121+ MonadIO m

3122+ => CodingFailureMode

3303−decodeUtf8Arrays :: MonadIO m => Stream m (A.Array Word8) -> Stream m Char

3123+ -> Stream m (A.Array Word8)

3124+ -> Stream m Char

3125+decodeUtf8ArraysWith cfm (Stream step state) =

3304−decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)

3126+ Stream step' (OuterLoop 0 0 state)

3305 where

3127 where

3128+ {-# INLINE transliterateOrError #-}

3129+ transliterateOrError e s =

3130+ case cfm of

3131+ ErrorOnCodingFailure -> error e

3132+ TransliterateCodingFailure -> YAndC replacementChar s

3133+ {-# INLINE inputUnderflow #-}

3134+ inputUnderflow =

3135+ case cfm of

3136+ ErrorOnCodingFailure ->

3137+ error

3138+ "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Input Underflow"

3139+ TransliterateCodingFailure -> YAndC replacementChar D

3306 {-# INLINE_LATE step' #-}

3140 {-# INLINE_LATE step' #-}

3307 step' gst (OuterLoop cp ds st) = do

3141 step' gst (OuterLoop cp ds st) = do

3308 r <- step (adaptState gst) st

3142 r <- step (adaptState gst) st

@@ -3312,7 +3146,10 @@ decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)

3312 let p = unsafeForeignPtrToPtr aStart

3146 let p = unsafeForeignPtrToPtr aStart

3313 in Skip (InnerLoop cp ds s aStart p aEnd)

3147 in Skip (InnerLoop cp ds s aStart p aEnd)

3314 Skip s -> Skip (OuterLoop cp ds s)

3148 Skip s -> Skip (OuterLoop cp ds s)

3315− Stop -> Stop

3149+ Stop ->

3150+ if ds /= 0

3151+ then Skip inputUnderflow

3152+ else Skip D

3316 step' _ (InnerLoop cp ds st _ p end)

3153 step' _ (InnerLoop cp ds st _ p end)

3317 | p == end = return $ Skip $ OuterLoop cp ds st

3154 | p == end = return $ Skip $ OuterLoop cp ds st

3318 step' _ (InnerLoop codepointPtr statePtr st startf p end) = do

3155 step' _ (InnerLoop codepointPtr statePtr st startf p end) = do

@@ -3321,26 +3158,63 @@ decodeUtf8Arrays (Stream step state) = Stream step' (OuterLoop 0 0 state)

3321 r <- peek p

3158 r <- peek p

3322 touchForeignPtr startf

3159 touchForeignPtr startf

3323 return r

3160 return r

3324− let (sv, cp) = decode (statePtr, codepointPtr) (fromIntegral x)

3161+ let (Tuple' sv cp) = decode statePtr codepointPtr (fromIntegral x)

3325 return $

3162 return $

3326 case sv of

3163 case sv of

3327− 12 -> error "UTF8: REJECT"

3164+ 12 ->

3165+ Skip $

3166+ transliterateOrError

3167+ "Streamly.Streams.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"

3168+ (InnerLoop 0 0 st startf (p `plusPtr` 1) end)

3328 0 ->

3169 0 ->

3329− Yield

3170+ Skip $

3171+ YAndC

3330 (unsafeChr (fromIntegral cp))

3172 (unsafeChr (fromIntegral cp))

3331− (InnerLoop

3173+ (InnerLoop cp sv st startf (p `plusPtr` 1) end)

3332− cp

3174+ _ -> Skip (InnerLoop cp sv st startf (p `plusPtr` 1) end)

3333− sv

3175+ step' _ (YAndC c s) = return $ Yield c s

3334− st

3176+ step' _ D = return Stop

3335− startf

3177+

3336− (p `plusPtr` 1)

3178+{-# INLINE decodeUtf8Arrays #-}

3337− end)

3179+decodeUtf8Arrays ::

3338− _ ->

3180+ MonadIO m

3181+ => Stream m (A.Array Word8)

3182+ -> Stream m Char

3183+decodeUtf8Arrays = decodeUtf8ArraysWith ErrorOnCodingFailure

3184+

3185+{-# INLINE decodeUtf8ArraysLenient #-}

3186+decodeUtf8ArraysLenient ::

3187+ MonadIO m

3188+ => Stream m (A.Array Word8)

3189+ -> Stream m Char

3190+decodeUtf8ArraysLenient = decodeUtf8ArraysWith TransliterateCodingFailure

3191+

3192+data WList = WCons !Word8 !WList | WNil

3193+

3194+data EncodeState s = EncodeState s !WList

3195+

3196+{-# INLINE_NORMAL encodeUtf8 #-}

3197+encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8

3198+encodeUtf8 (Stream step state) = Stream step' (EncodeState state WNil)

3199+ where

3200+ {-# INLINE_LATE step' #-}

3201+ step' gst (EncodeState st WNil) = do

3202+ r <- step (adaptState gst) st

3203+ return $

3204+ case r of

3205+ Yield c s ->

3206+ case ord c of

3207+ x

3208+ | x <= 0x7F ->

3339− Skip

3209+ Skip

3340− (InnerLoop

3210+ (EncodeState s (WCons (fromIntegral x) WNil))

3341− cp

3211+ | x <= 0x7FF -> Skip (EncodeState s (ord2 c))

3342− sv

3212+ | x <= 0xFFFF ->

3343− st

3213+ if isSurrogate c

3344− startf

3214+ then error

3345− (p `plusPtr` 1)

3215+ "Streamly.Streams.StreamD.encodeUtf8: Encountered a surrogate"

3346− end)

3216+ else Skip (EncodeState s (ord3 c))

3217+ | otherwise -> Skip (EncodeState s (ord4 c))

3218+ Skip s -> Skip (EncodeState s WNil)

3219+ Stop -> Stop

3220+ step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)