@@ -16,20 +16,24 @@ module Streamly.Internal.Unicode.Stream
1616 -- * Construction (Decoding)
1717 decodeLatin1
1818 , decodeUtf8
19− , decodeUtf8Lax
19+ , decodeUtf8'
20+ , decodeUtf8_
2021 , DecodeError(..)
2122 , DecodeState
2223 , CodePoint
2324 , decodeUtf8Either
2425 , resumeDecodeUtf8Either
2526 , decodeUtf8Arrays
26− , decodeUtf8ArraysLenient
27+ , decodeUtf8Arrays'
28+ , decodeUtf8Arrays_
2729
2830 -- * Elimination (Encoding)
2931 , encodeLatin1
30− , encodeLatin1Lax
32+ , encodeLatin1'
33+ , encodeLatin1_
3134 , encodeUtf8
32− , encodeUtf8Lax
35+ , encodeUtf8'
36+ , encodeUtf8_
3337 {-
3438 -- * Operations on character strings
3539 , strip -- (dropAround isSpace)
@@ -38,12 +42,16 @@ module Streamly.Internal.Unicode.Stream
3842
3943 -- * StreamD UTF8 Encoding / Decoding transformations.
4044 , decodeUtf8D
45+ , decodeUtf8D'
46+ , decodeUtf8D_
4147 , encodeUtf8D
42− , decodeUtf8LenientD
48+ , encodeUtf8D'
49+ , encodeUtf8D_
4350 , decodeUtf8EitherD
4451 , resumeDecodeUtf8EitherD
4552 , decodeUtf8ArraysD
46− , decodeUtf8ArraysLenientD
53+ , decodeUtf8ArraysD'
54+ , decodeUtf8ArraysD_
4755
4856 -- * Transformation
4957 , stripStart
@@ -51,12 +59,17 @@ module Streamly.Internal.Unicode.Stream
5159 , words
5260 , unlines
5361 , unwords
62+
63+ -- * Deprecations
64+ , decodeUtf8Lax
65+ , encodeLatin1Lax
66+ , encodeUtf8Lax
5467 )
5568where
5669
5770import Control.Monad.IO.Class (MonadIO, liftIO)
5871import Data.Bits (shiftR, shiftL, (.|.), (.&.))
59−import Data.Char (ord)
72+import Data.Char (chr, ord)
6073import Data.Word (Word8)
6174import Foreign.ForeignPtr (touchForeignPtr)
6275import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
@@ -118,6 +131,7 @@ ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
118131data CodingFailureMode
119132 = TransliterateCodingFailure
120133 | ErrorOnCodingFailure
134+ | DropOnCodingFailure
121135 deriving (Show)
122136
123137{-# INLINE replacementChar #-}
@@ -266,12 +280,14 @@ decodeUtf8WithD cfm (Stream step state) =
266280 case cfm of
267281 ErrorOnCodingFailure -> error e
268282 TransliterateCodingFailure -> YieldAndContinue replacementChar s
283+ DropOnCodingFailure -> s
269284
270285 {-# INLINE handleUnderflow #-}
271286 handleUnderflow =
272287 case cfm of
273288 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
274289 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
290+ DropOnCodingFailure -> Done
275291
276292 {-# INLINE_LATE step' #-}
277293 step' _ gst (FreshPointDecodeInit st) = do
@@ -337,11 +353,15 @@ decodeUtf8WithD cfm (Stream step state) =
337353
338354{-# INLINE decodeUtf8D #-}
339355decodeUtf8D :: Monad m => Stream m Word8 -> Stream m Char
340−decodeUtf8D = decodeUtf8WithD ErrorOnCodingFailure
356+decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
357+
358+{-# INLINE decodeUtf8D' #-}
359+decodeUtf8D' :: Monad m => Stream m Word8 -> Stream m Char
360+decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
341361
342−{-# INLINE decodeUtf8LenientD #-}
343−decodeUtf8LenientD :: Monad m => Stream m Word8 -> Stream m Char
344−decodeUtf8LenientD = decodeUtf8WithD TransliterateCodingFailure
362+{-# INLINE decodeUtf8D_ #-}
363+decodeUtf8D_ :: Monad m => Stream m Word8 -> Stream m Char
364+decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure
345365
346366{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
347367resumeDecodeUtf8EitherD
@@ -455,6 +475,7 @@ decodeUtf8ArraysWithD cfm (Stream step state) =
455475 case cfm of
456476 ErrorOnCodingFailure -> error e
457477 TransliterateCodingFailure -> YAndC replacementChar s
478+ DropOnCodingFailure -> s
458479 {-# INLINE inputUnderflow #-}
459480 inputUnderflow =
460481 case cfm of
@@ -462,6 +483,7 @@ decodeUtf8ArraysWithD cfm (Stream step state) =
462483 error
463484 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"
464485 TransliterateCodingFailure -> YAndC replacementChar D
486+ DropOnCodingFailure -> D
465487 {-# INLINE_LATE step' #-}
466488 step' _ gst (OuterLoop st Nothing) = do
467489 r <- step (adaptState gst) st
@@ -541,14 +563,21 @@ decodeUtf8ArraysD ::
541563 MonadIO m
542564 => Stream m (A.Array Word8)
543565 -> Stream m Char
544−decodeUtf8ArraysD = decodeUtf8ArraysWithD ErrorOnCodingFailure
566+decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure
567+
568+{-# INLINE decodeUtf8ArraysD' #-}
569+decodeUtf8ArraysD' ::
570+ MonadIO m
571+ => Stream m (A.Array Word8)
572+ -> Stream m Char
573+decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure
545574
546−{-# INLINE decodeUtf8ArraysLenientD #-}
547−decodeUtf8ArraysLenientD ::
575+{-# INLINE decodeUtf8ArraysD_ #-}
576+decodeUtf8ArraysD_ ::
548577 MonadIO m
549578 => Stream m (A.Array Word8)
550579 -> Stream m Char
551−decodeUtf8ArraysLenientD = decodeUtf8ArraysWithD TransliterateCodingFailure
580+decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure
552581
553582data EncodeState s = EncodeState s !WList
554583
@@ -556,9 +585,9 @@ data EncodeState s = EncodeState s !WList
556585-- too much code bloat or some trouble with fusion. So keeping only two yield
557586-- points for now, one for the ascii chars (fast path) and one for all other
558587-- paths (slow path).
559−{-# INLINE_NORMAL encodeUtf8D #-}
560−encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
561−encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
588+{-# INLINE_NORMAL encodeUtf8D' #-}
589+encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
590+encodeUtf8D' (Stream step state) = Stream step' (EncodeState state WNil)
562591 where
563592 {-# INLINE_LATE step' #-}
564593 step' gst (EncodeState st WNil) = do
@@ -585,7 +614,9 @@ encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
585614-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
586615-- corresponding Unicode 'Char' in 0-255 range.
587616--
588−-- /Since: 0.7.0/
617+-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
618+--
619+-- @since 0.8.0
589620{-# INLINE decodeLatin1 #-}
590621decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char
591622decodeLatin1 = S.map (unsafeChr . fromIntegral)
@@ -594,10 +625,10 @@ decodeLatin1 = S.map (unsafeChr . fromIntegral)
594625-- to a byte in 0-255 range. Throws an error if the input stream contains
595626-- characters beyond 255.
596627--
597−-- /Since: 0.7.0/
598−{-# INLINE encodeLatin1 #-}
599−encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
600−encodeLatin1 = S.map convert
628+-- @since 0.8.0
629+{-# INLINE encodeLatin1' #-}
630+encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8
631+encodeLatin1' = S.map convert
601632 where
602633 convert c =
603634 let codepoint = ord c
@@ -606,38 +637,71 @@ encodeLatin1 = S.map convert
606637 "input char codepoint " ++ show codepoint
607638 else fromIntegral codepoint
608639
609−-- | Like 'encodeLatin1' but silently truncates and maps input characters beyond
640+-- | Like 'encodeLatin1'' but silently truncates and maps input characters beyond
610641-- 255 to (incorrect) chars in 0-255 range. No error or exception is thrown
611642-- when such truncation occurs.
612643--
613−-- /Since: 0.7.0/
644+-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
645+--
646+-- /Since: 0.8.0 (Lenient Behaviour)/
647+{-# INLINE encodeLatin1 #-}
648+encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
649+encodeLatin1 = S.map (fromIntegral . ord)
650+
651+-- | Like 'encodeLatin1' but drops the input characters beyond 255.
652+--
653+-- @since 0.8.0
654+{-# INLINE encodeLatin1_ #-}
655+encodeLatin1_ :: (IsStream t, Monad m) => t m Char -> t m Word8
656+encodeLatin1_ = S.map (fromIntegral . ord) . S.filter (<= chr (255))
657+
658+-- | Same as 'encodeLatin1'
659+--
660+{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
614661{-# INLINE encodeLatin1Lax #-}
615662encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
616−encodeLatin1Lax = S.map (fromIntegral . ord)
663+encodeLatin1Lax = encodeLatin1
617664
618665-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
619−-- The incoming stream is truncated if an invalid codepoint is encountered.
666+-- The function throws an error if an invalid codepoint is encountered.
620667--
621−-- /Since: 0.7.0/
622−{-# INLINE decodeUtf8 #-}
623−decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
624−decodeUtf8 = D.fromStreamD . decodeUtf8D . D.toStreamD
668+-- @since 0.8.0
669+{-# INLINE decodeUtf8' #-}
670+decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char
671+decodeUtf8' = D.fromStreamD . decodeUtf8D' . D.toStreamD
625672
626673-- |
627674--
628675-- /Internal/
629−{-# INLINE decodeUtf8Arrays #-}
630−decodeUtf8Arrays :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
631−decodeUtf8Arrays = D.fromStreamD . decodeUtf8ArraysD . D.toStreamD
676+{-# INLINE decodeUtf8Arrays' #-}
677+decodeUtf8Arrays' :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
678+decodeUtf8Arrays' = D.fromStreamD . decodeUtf8ArraysD' . D.toStreamD
632679
633680-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
634681-- Any invalid codepoint encountered is replaced with the unicode replacement
635682-- character.
636683--
637−-- /Since: 0.7.0/
684+-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
685+--
686+-- /Since: 0.8.0 (Lenient Behaviour)/
687+{-# INLINE decodeUtf8 #-}
688+decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
689+decodeUtf8 = D.fromStreamD . decodeUtf8D . D.toStreamD
690+
691+-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
692+-- Any invalid codepoint encountered is dropped.
693+--
694+-- @since 0.8.0
695+{-# INLINE decodeUtf8_ #-}
696+decodeUtf8_ :: (Monad m, IsStream t) => t m Word8 -> t m Char
697+decodeUtf8_ = D.fromStreamD . decodeUtf8D_ . D.toStreamD
698+
699+-- | Same as 'decodeUtf8'
700+--
701+{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
638702{-# INLINE decodeUtf8Lax #-}
639−decodeUtf8Lax :: (Monad m, IsStream t) => t m Word8 -> t m Char
640−decodeUtf8Lax = D.fromStreamD . decodeUtf8LenientD . D.toStreamD
703+decodeUtf8Lax :: (IsStream t, Monad m) => t m Word8 -> t m Char
704+decodeUtf8Lax = decodeUtf8
641705
642706-- |
643707--
@@ -663,25 +727,36 @@ resumeDecodeUtf8Either st cp =
663727-- |
664728--
665729-- /Internal/
666−{-# INLINE decodeUtf8ArraysLenient #-}
667−decodeUtf8ArraysLenient ::
730+{-# INLINE decodeUtf8Arrays #-}
731+decodeUtf8Arrays ::
668732 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
669−decodeUtf8ArraysLenient =
670− D.fromStreamD . decodeUtf8ArraysLenientD . D.toStreamD
733+decodeUtf8Arrays =
734+ D.fromStreamD . decodeUtf8ArraysD . D.toStreamD
671735
672−-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.
736+-- |
673737--
674−-- /Since: 0.7.0/
675−{-# INLINE encodeUtf8 #-}
676−encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
677−encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
738+-- /Internal/
739+{-# INLINE decodeUtf8Arrays_ #-}
740+decodeUtf8Arrays_ ::
741+ (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
742+decodeUtf8Arrays_ =
743+ D.fromStreamD . decodeUtf8ArraysD_ . D.toStreamD
744+
745+-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
746+-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
747+-- function errors out.
748+--
749+-- @since 0.8.0
750+{-# INLINE encodeUtf8' #-}
751+encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
752+encodeUtf8' = D.fromStreamD . encodeUtf8D' . D.toStreamD
678753
679754-- | See section "3.9 Unicode Encoding Forms" in
680755-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
681756--
682−{-# INLINE_NORMAL encodeUtf8LaxD #-}
683−encodeUtf8LaxD :: Monad m => Stream m Char -> Stream m Word8
684−encodeUtf8LaxD (Stream step state) = Stream step' (EncodeState state WNil)
757+{-# INLINE_NORMAL encodeUtf8D #-}
758+encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
759+encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
685760 where
686761 {-# INLINE_LATE step' #-}
687762 step' gst (EncodeState st WNil) = do
@@ -710,10 +785,51 @@ encodeUtf8LaxD (Stream step state) = Stream step' (EncodeState state WNil)
710785-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
711786-- Unicode replacement character U+FFFD.
712787--
713−-- /Since: 0.8.0/
788+-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
789+--
790+-- /Since: 0.8.0 (Lenient Behaviour)/
791+{-# INLINE encodeUtf8 #-}
792+encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
793+encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
794+
795+{-# INLINE_NORMAL encodeUtf8D_ #-}
796+encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8
797+encodeUtf8D_ (Stream step state) = Stream step' (EncodeState state WNil)
798+ where
799+ {-# INLINE_LATE step' #-}
800+ step' gst (EncodeState st WNil) = do
801+ r <- step (adaptState gst) st
802+ return $
803+ case r of
804+ Yield c s ->
805+ case ord c of
806+ x | x <= 0x7F ->
807+ Yield (fromIntegral x) (EncodeState s WNil)
808+ | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
809+ | x <= 0xFFFF ->
810+ if isSurrogate c
811+ then Skip $
812+ EncodeState s WNil
813+ else Skip (EncodeState s (ord3 c))
814+ | otherwise -> Skip (EncodeState s (ord4 c))
815+ Skip s -> Skip (EncodeState s WNil)
816+ Stop -> Stop
817+ step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
818+
819+-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
820+-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
821+--
822+-- @since 0.8.0
823+{-# INLINE encodeUtf8_ #-}
824+encodeUtf8_ :: (Monad m, IsStream t) => t m Char -> t m Word8
825+encodeUtf8_ = D.fromStreamD . encodeUtf8D_ . D.toStreamD
826+
827+-- | Same as 'encodeUtf8'
828+--
829+{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
714830{-# INLINE encodeUtf8Lax #-}
715−encodeUtf8Lax :: (Monad m, IsStream t) => t m Char -> t m Word8
716−encodeUtf8Lax = D.fromStreamD . encodeUtf8LaxD . D.toStreamD
831+encodeUtf8Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
832+encodeUtf8Lax = encodeUtf8
717833
718834{-
719835-------------------------------------------------------------------------------