@@ -602,8 +602,9 @@ decodeUtf8ArraysWithD cfm (Stream step state) =
602602 inputUnderflow =
603603 case cfm of
604604 ErrorOnCodingFailure ->
605− error
606− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"
605+ error $
606+ show "Streamly.Internal.Data.Stream.StreamD."
607+ ++ "decodeUtf8ArraysWith: Input Underflow"
607608 TransliterateCodingFailure -> YAndC replacementChar D
608609 DropOnCodingFailure -> D
609610 {-# INLINE_LATE step' #-}
@@ -653,7 +654,11 @@ decodeUtf8ArraysWithD cfm (Stream step state) =
653654 12 ->
654655 Skip $
655656 transliterateOrError
656− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
657+ (
658+ "Streamly.Internal.Data.Stream.StreamD."
659+ ++ "decodeUtf8ArraysWith: Invalid UTF8"
660+ ++ " codepoint encountered"
661+ )
657662 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
658663 0 -> error "unreachable state"
659664 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
@@ -674,9 +679,15 @@ decodeUtf8ArraysWithD cfm (Stream step state) =
674679 12 ->
675680 Skip $
676681 transliterateOrError
677− "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
682+ (
683+ "Streamly.Internal.Data.Stream.StreamD."
684+ ++ "decodeUtf8ArraysWith: Invalid UTF8"
685+ ++ " codepoint encountered"
686+ )
678687 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
679− _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
688+ _ ->
689+ Skip
690+ (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
680691 step' _ _ (YAndC c s) = return $ Yield c s
681692 step' _ _ D = return Stop
682693
@@ -764,14 +775,34 @@ ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
764775{-# ANN type EncodeState Fuse #-}
765776data EncodeState s = EncodeState s !WList
766777
767−-- More yield points improve performance, but I am not sure if they can cause
768−-- too much code bloat or some trouble with fusion. So keeping only two yield
769−-- points for now, one for the ascii chars (fast path) and one for all other
770−-- paths (slow path).
771−{-# INLINE_NORMAL encodeUtf8D' #-}
772−encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
773−encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)
774− where
778+{-# ANN type InvalidAction Fuse #-}
779+data InvalidAction =
780+ DropInvalid | ErrorInvalid | IgnoreInvalid | ReplaceInvalid
781+
782+replaceInvalid :: s -> Step (EncodeState s) a
783+replaceInvalid s =
784+ Skip $ EncodeState s (WCons 239 (WCons 191 (WCons 189 WNil)))
785+
786+dropInvalid :: s -> Step (EncodeState s) a
787+dropInvalid s = Skip (EncodeState s WNil)
788+
789+errorOnInvalid :: s -> Step (EncodeState s) a
790+errorOnInvalid _ =
791+ error $
792+ show "Streamly.Internal.Data.Stream.StreamD.encodeUtf8:"
793+ ++ "Encountered a surrogate"
794+
795+{-# INLINE_NORMAL encodeUtf8DGeneric #-}
796+encodeUtf8DGeneric ::
797+ Monad m
798+ => InvalidAction
799+ -> Stream m Char
800+ -> Stream m Word8
801+encodeUtf8DGeneric act (Stream step state) =
802+ Stream step' (EncodeState state WNil)
803+
804+ where
805+
775806 {-# INLINE_LATE step' #-}
776807 step' gst (EncodeState st WNil) = do
777808 r <- step (adaptState gst) st
@@ -779,20 +810,41 @@ encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)
779810 case r of
780811 Yield c s ->
781812 case ord c of
782− x
783− | x <= 0x7F ->
813+ x | x <= 0x7F ->
784814 Yield (fromIntegral x) (EncodeState s WNil)
785815 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
786816 | x <= 0xFFFF ->
787− if isSurrogate c
788− then error
789− "Streamly.Internal.Data.Stream.StreamD.encodeUtf8: Encountered a surrogate"
790− else Skip (EncodeState s (ord3 c))
817+ case act of
818+ DropInvalid ->
819+ if isSurrogate c
820+ then dropInvalid s
821+ else Skip (EncodeState s (ord3 c))
822+
823+ ErrorInvalid ->
824+ if isSurrogate c
825+ then errorOnInvalid s
826+ else Skip (EncodeState s (ord3 c))
827+
828+ IgnoreInvalid ->
829+ Skip (EncodeState s (ord3 c))
830+
831+ ReplaceInvalid ->
832+ if isSurrogate c
833+ then replaceInvalid s
834+ else Skip (EncodeState s (ord3 c))
835+
791836 | otherwise -> Skip (EncodeState s (ord4 c))
792837 Skip s -> Skip (EncodeState s WNil)
793838 Stop -> Stop
794839 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
795840
841+-- More yield points improve performance, but I am not sure if they can cause
842+-- too much code bloat or some trouble with fusion. So keeping only two yield
843+-- points for now, one for the ascii chars (fast path) and one for all other
844+-- paths (slow path).
845+{-# INLINE_NORMAL encodeUtf8D' #-}
846+encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
847+encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid
796848
797849-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
798850-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
@@ -808,30 +860,7 @@ encodeUtf8' = D.fromStreamD . encodeUtf8D' . D.toStreamD
808860--
809861{-# INLINE_NORMAL encodeUtf8D #-}
810862encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
811−encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
812− where
813− {-# INLINE_LATE step' #-}
814− step' gst (EncodeState st WNil) = do
815− r <- step (adaptState gst) st
816− return $
817− case r of
818− Yield c s ->
819− case ord c of
820− x | x <= 0x7F ->
821− Yield (fromIntegral x) (EncodeState s WNil)
822− | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
823− | x <= 0xFFFF ->
824− if isSurrogate c
825− then Skip $
826− EncodeState
827− s
828− (WCons 239 (WCons 191 (WCons 189 WNil)))
829− else Skip (EncodeState s (ord3 c))
830− | otherwise -> Skip (EncodeState s (ord4 c))
831− Skip s -> Skip (EncodeState s WNil)
832− Stop -> Stop
833− step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
834−
863+encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid
835864
836865-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
837866-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
@@ -846,27 +875,7 @@ encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
846875
847876{-# INLINE_NORMAL encodeUtf8D_ #-}
848877encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8
849−encodeUtf8D_ (Stream step state) = Stream step' (EncodeState state WNil)
850− where
851− {-# INLINE_LATE step' #-}
852− step' gst (EncodeState st WNil) = do
853− r <- step (adaptState gst) st
854− return $
855− case r of
856− Yield c s ->
857− case ord c of
858− x | x <= 0x7F ->
859− Yield (fromIntegral x) (EncodeState s WNil)
860− | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
861− | x <= 0xFFFF ->
862− if isSurrogate c
863− then Skip $
864− EncodeState s WNil
865− else Skip (EncodeState s (ord3 c))
866− | otherwise -> Skip (EncodeState s (ord4 c))
867− Skip s -> Skip (EncodeState s WNil)
868− Stop -> Stop
869− step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
878+encodeUtf8D_ = encodeUtf8DGeneric DropInvalid
870879
871880-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
872881-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.