@@ -38,6 +38,7 @@ module Streamly.Internal.Unicode.Stream
3838 , encodeLatin1_
3939
4040 -- ** UTF-8 Encoding
41+ , readCharUtf8'
4142 , encodeUtf8
4243 , encodeUtf8'
4344 , encodeUtf8_
@@ -96,7 +97,7 @@ import Streamly.Internal.Data.Stream.Serial (SerialT)
9697import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))
9798import Streamly.Internal.Data.SVar (adaptState)
9899import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
99−import Streamly.Internal.Data.Unfold (Unfold)
100+import Streamly.Internal.Data.Unfold.Type (Unfold(..))
100101import Streamly.Internal.System.IO (unsafeInlineIO)
101102
102103import qualified Streamly.Internal.Data.Unfold as Unfold
@@ -775,75 +776,28 @@ ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
775776 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
776777 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
777778
778−#ifndef __GHCJS__
779−{-# ANN type EncodeState Fuse #-}
780−#endif
781−data EncodeState s = EncodeState s !WList
782−
783−#ifndef __GHCJS__
784−{-# ANN type InvalidAction Fuse #-}
785−#endif
786−data InvalidAction =
787− DropInvalid | ErrorInvalid | IgnoreInvalid | ReplaceInvalid
788−
789−replaceInvalid :: s -> Step (EncodeState s) a
790−replaceInvalid s =
791− Skip $ EncodeState s (WCons 239 (WCons 191 (WCons 189 WNil)))
792−
793−dropInvalid :: s -> Step (EncodeState s) a
794−dropInvalid s = Skip (EncodeState s WNil)
795−
796−errorOnInvalid :: s -> Step (EncodeState s) a
797−errorOnInvalid _ =
798− error $
799− show "Streamly.Internal.Data.Stream.StreamD.encodeUtf8:"
800− ++ "Encountered a surrogate"
801−
802−{-# INLINE_NORMAL encodeUtf8DGeneric #-}
803−encodeUtf8DGeneric ::
804− Monad m
805− => InvalidAction
806− -> Stream m Char
807− -> Stream m Word8
808−encodeUtf8DGeneric act (Stream step state) =
809− Stream step' (EncodeState state WNil)
779+{-# INLINE_NORMAL readCharUtf8With #-}
780+readCharUtf8With :: Monad m => WList -> Unfold m Char Word8
781+readCharUtf8With surr = Unfold step inject
810782
811783 where
812784
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− case act of
825− DropInvalid ->
826− if isSurrogate c
827− then dropInvalid s
828− else Skip (EncodeState s (ord3 c))
829−
830− ErrorInvalid ->
831− if isSurrogate c
832− then errorOnInvalid s
833− else Skip (EncodeState s (ord3 c))
834−
835− IgnoreInvalid ->
836− Skip (EncodeState s (ord3 c))
837−
838− ReplaceInvalid ->
839− if isSurrogate c
840− then replaceInvalid s
841− else Skip (EncodeState s (ord3 c))
842−
843− | otherwise -> Skip (EncodeState s (ord4 c))
844− Skip s -> Skip (EncodeState s WNil)
845− Stop -> Stop
846− step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
785+ inject c =
786+ return $ case ord c of
787+ x | x <= 0x7F -> fromIntegral x `WCons` WNil
788+ | x <= 0x7FF -> ord2 c
789+ | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c
790+ | otherwise -> ord4 c
791+
792+ {-# INLINE_LATE step #-}
793+ step WNil = return Stop
794+ step (WCons x xs) = return $ Yield x xs
795+
796+{-# INLINE_NORMAL readCharUtf8' #-}
797+readCharUtf8' :: Monad m => Unfold m Char Word8
798+readCharUtf8' =
799+ readCharUtf8With $
800+ error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
847801
848802-- More yield points improve performance, but I am not sure if they can cause
849803-- too much code bloat or some trouble with fusion. So keeping only two yield
@@ -851,7 +805,7 @@ encodeUtf8DGeneric act (Stream step state) =
851805-- paths (slow path).
852806{-# INLINE_NORMAL encodeUtf8D' #-}
853807encodeUtf8D' :: Monad m => Stream m Char -> Stream m Word8
854−encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid
808+encodeUtf8D' = D.unfoldMany readCharUtf8'
855809
856810-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
857811-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
@@ -862,12 +816,16 @@ encodeUtf8D' = encodeUtf8DGeneric ErrorInvalid
862816encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
863817encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD
864818
819+{-# INLINE_NORMAL readCharUtf8 #-}
820+readCharUtf8 :: Monad m => Unfold m Char Word8
821+readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))
822+
865823-- | See section "3.9 Unicode Encoding Forms" in
866824-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
867825--
868826{-# INLINE_NORMAL encodeUtf8D #-}
869827encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
870−encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid
828+encodeUtf8D = D.unfoldMany readCharUtf8
871829
872830-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
873831-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
@@ -880,9 +838,13 @@ encodeUtf8D = encodeUtf8DGeneric ReplaceInvalid
880838encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
881839encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD
882840
841+{-# INLINE_NORMAL readCharUtf8_ #-}
842+readCharUtf8_ :: Monad m => Unfold m Char Word8
843+readCharUtf8_ = readCharUtf8With WNil
844+
883845{-# INLINE_NORMAL encodeUtf8D_ #-}
884846encodeUtf8D_ :: Monad m => Stream m Char -> Stream m Word8
885−encodeUtf8D_ = encodeUtf8DGeneric DropInvalid
847+encodeUtf8D_ = D.unfoldMany readCharUtf8_
886848
887849-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
888850-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.