@@ -29,6 +29,7 @@ module Streamly.Internal.Data.Unicode.Stream
2929 , encodeLatin1
3030 , encodeLatin1Lax
3131 , encodeUtf8
32+ , encodeUtf8Lax
3233 {-
3334 -- * Operations on character strings
3435 , strip -- (dropAround isSpace)
@@ -675,6 +676,45 @@ decodeUtf8ArraysLenient =
675676encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
676677encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
677678
679+-- | See section "3.9 Unicode Encoding Forms" in
680+-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
681+--
682+{-# INLINE_NORMAL encodeUtf8LaxD #-}
683+encodeUtf8LaxD :: Monad m => Stream m Char -> Stream m Word8
684+encodeUtf8LaxD (Stream step state) = Stream step' (EncodeState state WNil)
685+ where
686+ {-# INLINE_LATE step' #-}
687+ step' gst (EncodeState st WNil) = do
688+ r <- step (adaptState gst) st
689+ return $
690+ case r of
691+ Yield c s ->
692+ case ord c of
693+ x | x <= 0x7F ->
694+ Yield (fromIntegral x) (EncodeState s WNil)
695+ | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
696+ | x <= 0xFFFF ->
697+ if isSurrogate c
698+ then Skip $
699+ EncodeState
700+ s
701+ (WCons 239 (WCons 191 (WCons 189 WNil)))
702+ else Skip (EncodeState s (ord3 c))
703+ | otherwise -> Skip (EncodeState s (ord4 c))
704+ Skip s -> Skip (EncodeState s WNil)
705+ Stop -> Stop
706+ step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
707+
708+
709+-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
710+-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
711+-- Unicode replacement character U+FFFD.
712+--
713+-- /Since: 0.8.0/
714+{-# INLINE encodeUtf8Lax #-}
715+encodeUtf8Lax :: (Monad m, IsStream t) => t m Char -> t m Word8
716+encodeUtf8Lax = D.fromStreamD . encodeUtf8LaxD . D.toStreamD
717+
678718{-
679719-------------------------------------------------------------------------------
680720-- Utility operations on strings