2-- Module : Streamly.Internal.Unicode.Stream
3-- Copyright : (c) 2018 Composewell Technologies
4-- (c) Bjoern Hoehrmann 2008-2009
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
12module Streamly.Internal.Unicode.Stream
14 -- * Construction (Decoding)
18 , CodingFailureMode(..)
25 -- ** Resumable UTF-8 Decoding
30 , resumeDecodeUtf8Either
32 -- ** UTF-8 Array Stream Decoding
37 -- * Elimination (Encoding)
50 -- * Operations on character strings
51 , strip -- (dropAround isSpace)
62 -- * StreamD UTF8 Encoding / Decoding transformations.
70 , resumeDecodeUtf8EitherD
75 -- * Decoding String Literals
87import Control.Monad (void)
88import Control.Monad.Catch (MonadThrow(..), MonadCatch)
89import Control.Monad.IO.Class (MonadIO, liftIO)
90import Data.Bits (shiftR, shiftL, (.|.), (.&.))
91import Data.Char (chr, ord)
92#if MIN_VERSION_base(4,17,0)
93import Data.Char (generalCategory, GeneralCategory(Space))
95import Data.Word (Word8)
96import Foreign.Marshal.Alloc (mallocBytes)
97import Foreign.Storable (Storable(..))
99import Fusion.Plugin.Types (Fuse(..))
101import GHC.Base (assert, unsafeChr)
102import GHC.Exts (Addr#)
103import GHC.IO.Encoding.Failure (isSurrogate)
104import GHC.Ptr (Ptr (..), plusPtr)
105import System.IO.Unsafe (unsafePerformIO)
106import Streamly.Internal.Data.Array.Unboxed.Type (Array(..))
107import Streamly.Internal.Data.Array.Unboxed.Mut.Type (MutableByteArray)
108import Streamly.Internal.Data.Fold (Fold)
109import Streamly.Internal.Data.Stream (Stream, fromStreamD, toStreamD)
110import Streamly.Internal.Data.Stream.StreamD (Step (..))
111import Streamly.Internal.Data.SVar.Type (adaptState)
112import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
113import Streamly.Internal.Data.Unboxed (peekWith)
114import Streamly.Internal.Data.Unfold.Type (Unfold(..))
115import Streamly.Internal.System.IO (unsafeInlineIO)
117import qualified Streamly.Data.Fold as Fold
118import qualified Streamly.Data.Unfold as Unfold
119import qualified Streamly.Internal.Data.Array.Unboxed.Type as Array
120import qualified Streamly.Internal.Data.Parser as Parser (Parser)
121import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
122import qualified Streamly.Internal.Data.Stream as Stream
123import qualified Streamly.Internal.Data.Stream.StreamD as D
125import Prelude hiding (lines, words, unlines, unwords)
129-- >>> :set -XMagicHash
130-- >>> import Prelude hiding (lines, words, unlines, unwords)
131-- >>> import qualified Streamly.Prelude as Stream
132-- >>> import qualified Streamly.Data.Fold as Fold
133-- >>> import qualified Streamly.Internal.Unicode.Stream as Unicode
134-- >>> import Streamly.Internal.Unicode.Stream
136-------------------------------------------------------------------------------
138-------------------------------------------------------------------------------
140-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
141-- corresponding Unicode 'Char' in 0-255 range.
143-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
146{-# INLINE decodeLatin1 #-}
147decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char
148decodeLatin1 = fmap (unsafeChr . fromIntegral)
150-------------------------------------------------------------------------------
152-------------------------------------------------------------------------------
154-- | Encode a stream of Unicode characters to bytes by mapping each character
155-- to a byte in 0-255 range. Throws an error if the input stream contains
156-- characters beyond 255.
159{-# INLINE encodeLatin1' #-}
160encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8
161encodeLatin1' = fmap convert
164 let codepoint = ord c
165 in if codepoint > 255
166 then error $ "Streamly.Unicode.encodeLatin1 invalid " ++
167 "input char codepoint " ++ show codepoint
168 else fromIntegral codepoint
170-- XXX Should we instead replace the invalid chars by NUL or whitespace or some
171-- other control char? That may affect the perf a bit but may be a better
174-- | Like 'encodeLatin1'' but silently maps input codepoints beyond 255 to
175-- arbitrary Latin1 chars in 0-255 range. No error or exception is thrown when
176-- such mapping occurs.
178-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
180-- /Since: 0.8.0 (Lenient Behaviour)/
181{-# INLINE encodeLatin1 #-}
182encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8
183encodeLatin1 = fmap (fromIntegral . ord)
185-- | Like 'encodeLatin1' but drops the input characters beyond 255.
188{-# INLINE encodeLatin1_ #-}
189encodeLatin1_ :: Monad m => Stream m Char -> Stream m Word8
190encodeLatin1_ = fmap (fromIntegral . ord) . Stream.filter (<= chr 255)
192-- | Same as 'encodeLatin1'
194{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
195{-# INLINE encodeLatin1Lax #-}
196encodeLatin1Lax :: Monad m => Stream m Char -> Stream m Word8
197encodeLatin1Lax = encodeLatin1
199-------------------------------------------------------------------------------
201-------------------------------------------------------------------------------
203-- Int helps in cheaper conversion from Int to Char
205type DecodeState = Word8
207-- We can divide the errors in three general categories:
208-- * A non-starter was encountered in a begin state
209-- * A starter was encountered without completing a codepoint
210-- * The last codepoint was not complete (input underflow)
212-- Need to separate resumable and non-resumable error. In case of non-resumable
213-- error we can also provide the failing byte. In case of resumable error the
214-- state can be opaque.
216data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
218-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
220-- XXX Use names decodeSuccess = 0, decodeFailure = 12
222decodeTable :: [Word8]
224 -- The first part of the table maps bytes to character classes that
225 -- to reduce the size of the transition table and create bitmasks.
226 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,
227 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,
228 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,
229 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,
230 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,
231 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
232 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
233 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,
235 -- The second part is a transition table that maps a combination
236 -- of a state of the automaton and a character class to a state.
237 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
238 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
239 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
240 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
241 12,36,12,12,12,12,12,12,12,12,12,12
244{-# INLINE utf8dLength #-}
246utf8dLength = length decodeTable
248-- | We do not want to garbage collect this and free the memory, we want to
249-- keep this persistent. We don't know how to do that with GHC without having a
250-- reference in some global structure. So we use a hack, use mallocBytes so
251-- that the GC has no way to free it.
252{-# NOINLINE utf8d #-}
254utf8d = unsafePerformIO $ do
255 let size = utf8dLength
256 p <- liftIO $ mallocBytes size
258 (Fold.foldlM' (\b a -> poke b a >> return (b `plusPtr` 1)) (return p))
259 (D.fromList decodeTable)
262-- | Return element at the specified index without checking the bounds.
263-- and without touching the foreign ptr.
264{-# INLINE_NORMAL unsafePeekElemOff #-}
265unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
266unsafePeekElemOff p i =
267 let !x = unsafeInlineIO $ peekElemOff p i
270-- XXX We can use a fromPtr stream to implement it.
271{-# INLINE showMemory #-}
273 forall a. (Show a, Storable a) => Ptr a -> Ptr a -> String
276 let cur1 = cur `plusPtr` sizeOf (undefined :: a)
277 in show (unsafeInlineIO $ peek cur) ++ " " ++ showMemory cur1 end
280-- decode is split into two separate cases to avoid branching instructions.
281-- From the higher level flow we already know which case we are in so we can
282-- call the appropriate decode function.
284-- When the state is 0
285{-# INLINE decode0 #-}
286decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
288 let !t = table `unsafePeekElemOff` fromIntegral byte
289 !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte
290 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
291 in assert ((byte > 0x7f || error showByte)
292 && (state' /= 0 || error (showByte ++ showTable)))
293 (Tuple' state' codep')
297 utf8tableEnd = table `plusPtr` 364
298 showByte = "Streamly: decode0: byte: " ++ show byte
299 showTable = " table: " ++ showMemory table utf8tableEnd
301-- When the state is not 0
302{-# INLINE decode1 #-}
308 -> Tuple' DecodeState CodePoint
309decode1 table state codep byte =
310 -- Remember codep is Int type!
311 -- Can it be unsafe to convert the resulting Int to Char?
312 let !t = table `unsafePeekElemOff` fromIntegral byte
313 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
314 !state' = table `unsafePeekElemOff`
315 (256 + fromIntegral state + fromIntegral t)
316 in assert (codep' <= 0x10FFFF
317 || error (showByte ++ showState state codep))
318 (Tuple' state' codep')
321 utf8tableEnd = table `plusPtr` 364
322 showByte = "Streamly: decode1: byte: " ++ show byte
324 " state: " ++ show st ++
325 " codepoint: " ++ show cp ++
326 " table: " ++ showMemory table utf8tableEnd
328-------------------------------------------------------------------------------
329-- Resumable UTF-8 decoding
330-------------------------------------------------------------------------------
332-- Strangely, GHCJS hangs linking template-haskell with this
334{-# ANN type UTF8DecodeState Fuse #-}
336data UTF8DecodeState s a
338 | UTF8DecodeInit1 s Word8
339 | UTF8DecodeFirst s Word8
340 | UTF8Decoding s !DecodeState !CodePoint
341 | YieldAndContinue a (UTF8DecodeState s a)
344{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
345resumeDecodeUtf8EitherD
350 -> D.Stream m (Either DecodeError Char)
351resumeDecodeUtf8EitherD dst codep (D.Stream step state) =
354 then UTF8DecodeInit state
355 else UTF8Decoding state dst codep
356 in D.Stream (step' utf8d) stt
358 {-# INLINE_LATE step' #-}
359 step' _ gst (UTF8DecodeInit st) = do
360 r <- step (adaptState gst) st
362 Yield x s -> Skip (UTF8DecodeInit1 s x)
363 Skip s -> Skip (UTF8DecodeInit s)
366 step' _ _ (UTF8DecodeInit1 st x) = do
367 -- Note: It is important to use a ">" instead of a "<=" test
368 -- here for GHC to generate code layout for default branch
369 -- prediction for the common case. This is fragile and might
370 -- change with the compiler versions, we need a more reliable
371 -- "likely" primitive to control branch predication.
374 return $ Skip $ YieldAndContinue
375 (Right $ unsafeChr (fromIntegral x))
377 -- Using a separate state here generates a jump to a
378 -- separate code block in the core which seems to perform
379 -- slightly better for the non-ascii case.
380 True -> return $ Skip $ UTF8DecodeFirst st x
382 -- XXX should we merge it with UTF8DecodeInit1?
383 step' table _ (UTF8DecodeFirst st x) = do
384 let (Tuple' sv cp) = decode0 table x
388 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
390 0 -> error "unreachable state"
391 _ -> Skip (UTF8Decoding st sv cp)
393 -- We recover by trying the new byte x a starter of a new codepoint.
394 -- XXX on error need to report the next byte "x" as well.
395 -- XXX need to use the same recovery in array decoding routine as well
396 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
397 r <- step (adaptState gst) st
400 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
403 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
406 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
407 (UTF8DecodeInit1 s x)
408 _ -> Skip (UTF8Decoding s sv cp)
409 Skip s -> return $ Skip (UTF8Decoding s statePtr codepointPtr)
410 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
412 step' _ _ (YieldAndContinue c s) = return $ Yield c s
413 step' _ _ Done = return Stop
415-- XXX We can use just one API, and define InitState = 0 and InitCodePoint = 0
416-- to use as starting state.
418{-# INLINE_NORMAL decodeUtf8EitherD #-}
419decodeUtf8EitherD :: Monad m
420 => D.Stream m Word8 -> D.Stream m (Either DecodeError Char)
421decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
426{-# INLINE decodeUtf8Either #-}
427decodeUtf8Either :: Monad m
428 => Stream m Word8 -> Stream m (Either DecodeError Char)
429decodeUtf8Either = fromStreamD . decodeUtf8EitherD . toStreamD
434{-# INLINE resumeDecodeUtf8Either #-}
435resumeDecodeUtf8Either
440 -> Stream m (Either DecodeError Char)
441resumeDecodeUtf8Either st cp =
442 fromStreamD . resumeDecodeUtf8EitherD st cp . toStreamD
444-------------------------------------------------------------------------------
446-------------------------------------------------------------------------------
448data CodingFailureMode
449 = TransliterateCodingFailure
450 | ErrorOnCodingFailure
451 | DropOnCodingFailure
454{-# INLINE replacementChar #-}
455replacementChar :: Char
456replacementChar = '\xFFFD'
458data UTF8CharDecodeState a
460 | UTF8CharDecoding !DecodeState !CodePoint
462{-# INLINE parseCharUtf8WithD #-}
464 MonadThrow m => CodingFailureMode -> ParserD.Parser m Word8 Char
465parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract
469 prefix = "Streamly.Internal.Data.Stream.parseCharUtf8WithD:"
471 {-# INLINE initial #-}
472 initial = return $ ParserD.IPartial UTF8CharDecodeInit
474 handleError err souldBackTrack =
476 ErrorOnCodingFailure -> ParserD.Error err
477 TransliterateCodingFailure ->
478 case souldBackTrack of
479 True -> ParserD.Done 1 replacementChar
480 False -> ParserD.Done 0 replacementChar
481 DropOnCodingFailure ->
482 case souldBackTrack of
483 True -> ParserD.Continue 1 UTF8CharDecodeInit
484 False -> ParserD.Continue 0 UTF8CharDecodeInit
487 step' table UTF8CharDecodeInit x =
488 -- Note: It is important to use a ">" instead of a "<=" test
489 -- here for GHC to generate code layout for default branch
490 -- prediction for the common case. This is fragile and might
491 -- change with the compiler versions, we need a more reliable
492 -- "likely" primitive to control branch predication.
493 return $ case x > 0x7f of
494 False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x
496 let (Tuple' sv cp) = decode0 table x
500 ++ "Invalid first UTF8 byte" ++ show x
501 in handleError msg False
502 0 -> error $ prefix ++ "unreachable state"
503 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
505 step' table (UTF8CharDecoding statePtr codepointPtr) x = return $
506 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
508 0 -> ParserD.Done 0 $ unsafeChr cp
511 ++ "Invalid subsequent UTF8 byte"
515 ++ "accumulated value"
517 in handleError msg True
518 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
520 {-# INLINE extract #-}
521 extract UTF8CharDecodeInit = error $ prefix ++ "Not enough input"
522 extract (UTF8CharDecoding _ _) =
524 ErrorOnCodingFailure ->
525 return $ ParserD.Error $ prefix ++ "Not enough input"
526 TransliterateCodingFailure ->
527 return (ParserD.Done 0 replacementChar)
528 -- XXX We shouldn't error out here. There is no way to represent an
529 -- empty parser result unless we return a "Maybe" type.
530 DropOnCodingFailure -> error $ prefix ++ "Not enough input"
532-- XXX This should ideally accept a "CodingFailureMode" and perform appropriate
533-- error handling. This isn't possible now as "TransliterateCodingFailure"'s
534-- workflow requires backtracking 1 element. This can be revisited once "Fold"
535-- supports backtracking.
536{-# INLINE writeCharUtf8' #-}
537writeCharUtf8' :: MonadThrow m => Fold m Word8 Char
538writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)
540-- XXX The initial idea was to have "parseCharUtf8" and offload the error
541-- handling to another parser. So, say we had "parseCharUtf8'",
543-- >>> parseCharUtf8Smart = parseCharUtf8' <|> Parser.fromPure replacementChar
545-- But unfortunately parseCharUtf8Smart used in conjunction with "parseMany" -
546-- that is "parseMany parseCharUtf8Smart" on a stream causes the heap to
547-- overflow. Even a heap size of 500 MB was not sufficient.
549-- This needs to be investigated futher.
550{-# INLINE parseCharUtf8With #-}
552 MonadCatch m => CodingFailureMode -> Parser.Parser m Word8 Char
553parseCharUtf8With = ParserD.toParserK . parseCharUtf8WithD
555-- XXX write it as a parser and use parseMany to decode a stream, need to check
556-- if that preserves the same performance. Or we can use a resumable parser
557-- that parses a chunk at a time.
559-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
560-- decodeUtf8Either preserves the performance characterstics.
562{-# INLINE_NORMAL decodeUtf8WithD #-}
563decodeUtf8WithD :: Monad m
564 => CodingFailureMode -> D.Stream m Word8 -> D.Stream m Char
565decodeUtf8WithD cfm (D.Stream step state) =
566 D.Stream (step' utf8d) (UTF8DecodeInit state)
570 prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
572 {-# INLINE handleError #-}
575 ErrorOnCodingFailure -> error e
576 TransliterateCodingFailure -> YieldAndContinue replacementChar s
577 DropOnCodingFailure -> s
579 {-# INLINE handleUnderflow #-}
582 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
583 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
584 DropOnCodingFailure -> Done
586 {-# INLINE_LATE step' #-}
587 step' _ gst (UTF8DecodeInit st) = do
588 r <- step (adaptState gst) st
590 Yield x s -> Skip (UTF8DecodeInit1 s x)
591 Skip s -> Skip (UTF8DecodeInit s)
594 step' _ _ (UTF8DecodeInit1 st x) = do
595 -- Note: It is important to use a ">" instead of a "<=" test
596 -- here for GHC to generate code layout for default branch
597 -- prediction for the common case. This is fragile and might
598 -- change with the compiler versions, we need a more reliable
599 -- "likely" primitive to control branch predication.
602 return $ Skip $ YieldAndContinue
603 (unsafeChr (fromIntegral x))
605 -- Using a separate state here generates a jump to a
606 -- separate code block in the core which seems to perform
607 -- slightly better for the non-ascii case.
608 True -> return $ Skip $ UTF8DecodeFirst st x
610 -- XXX should we merge it with UTF8DecodeInit1?
611 step' table _ (UTF8DecodeFirst st x) = do
612 let (Tuple' sv cp) = decode0 table x
616 let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
617 in Skip $ handleError msg (UTF8DecodeInit st)
618 0 -> error "unreachable state"
619 _ -> Skip (UTF8Decoding st sv cp)
621 -- We recover by trying the new byte x as a starter of a new codepoint.
622 -- XXX need to use the same recovery in array decoding routine as well
623 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
624 r <- step (adaptState gst) st
627 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
629 0 -> Skip $ YieldAndContinue
630 (unsafeChr cp) (UTF8DecodeInit s)
633 ++ "Invalid subsequent UTF8 byte "
637 ++ " accumulated value "
639 in Skip $ handleError msg (UTF8DecodeInit1 s x)
640 _ -> Skip (UTF8Decoding s sv cp)
642 Skip (UTF8Decoding s statePtr codepointPtr)
643 Stop -> return $ Skip handleUnderflow
645 step' _ _ (YieldAndContinue c s) = return $ Yield c s
646 step' _ _ Done = return Stop
648{-# INLINE decodeUtf8D #-}
649decodeUtf8D :: Monad m => D.Stream m Word8 -> D.Stream m Char
650decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
652-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
653-- Any invalid codepoint encountered is replaced with the unicode replacement
656-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
658-- /Since: 0.8.0 (Lenient Behaviour)/
659{-# INLINE decodeUtf8 #-}
660decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
661decodeUtf8 = fromStreamD . decodeUtf8D . toStreamD
663{-# INLINE decodeUtf8D' #-}
664decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char
665decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
667-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
668-- The function throws an error if an invalid codepoint is encountered.
671{-# INLINE decodeUtf8' #-}
672decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char
673decodeUtf8' = fromStreamD . decodeUtf8D' . toStreamD
675{-# INLINE decodeUtf8D_ #-}
676decodeUtf8D_ :: Monad m => D.Stream m Word8 -> D.Stream m Char
677decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure
679-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
680-- Any invalid codepoint encountered is dropped.
683{-# INLINE decodeUtf8_ #-}
684decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char
685decodeUtf8_ = fromStreamD . decodeUtf8D_ . toStreamD
687-- | Same as 'decodeUtf8'
689{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
690{-# INLINE decodeUtf8Lax #-}
691decodeUtf8Lax :: Monad m => Stream m Word8 -> Stream m Char
692decodeUtf8Lax = decodeUtf8
694-------------------------------------------------------------------------------
695-- Decoding Array Streams
696-------------------------------------------------------------------------------
699{-# ANN type FlattenState Fuse #-}
702 = OuterLoop s !(Maybe (DecodeState, CodePoint))
703 | InnerLoopDecodeInit s (MutableByteArray a) !Int !Int
704 | InnerLoopDecodeFirst s (MutableByteArray a) !Int !Int Word8
705 | InnerLoopDecoding s (MutableByteArray a) !Int !Int
706 !DecodeState !CodePoint
707 | YAndC !Char (FlattenState s a) -- These constructors can be
708 -- encoded in the UTF8DecodeState
709 -- type, I prefer to keep these
710 -- flat even though that means
711 -- coming up with new names
714-- The normal decodeUtf8 above should fuse with flattenArrays
715-- to create this exact code but it doesn't for some reason, as of now this
716-- remains the fastest way I could figure out to decodeUtf8.
718-- XXX Add Proper error messages
719{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
720decodeUtf8ArraysWithD ::
723 -> D.Stream m (Array Word8)
725decodeUtf8ArraysWithD cfm (D.Stream step state) =
726 D.Stream (step' utf8d) (OuterLoop state Nothing)
728 {-# INLINE transliterateOrError #-}
729 transliterateOrError e s =
731 ErrorOnCodingFailure -> error e
732 TransliterateCodingFailure -> YAndC replacementChar s
733 DropOnCodingFailure -> s
734 {-# INLINE inputUnderflow #-}
737 ErrorOnCodingFailure ->
739 show "Streamly.Internal.Data.Stream.StreamD."
740 ++ "decodeUtf8ArraysWith: Input Underflow"
741 TransliterateCodingFailure -> YAndC replacementChar D
742 DropOnCodingFailure -> D
743 {-# INLINE_LATE step' #-}
744 step' _ gst (OuterLoop st Nothing) = do
745 r <- step (adaptState gst) st
748 Yield Array {..} s ->
749 Skip (InnerLoopDecodeInit s arrContents arrStart arrEnd)
750 Skip s -> Skip (OuterLoop s Nothing)
752 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
753 r <- step (adaptState gst) st
756 Yield Array {..} s ->
757 Skip (InnerLoopDecoding s arrContents arrStart arrEnd ds cp)
758 Skip s -> Skip (OuterLoop s dst)
759 Stop -> Skip inputUnderflow
760 step' _ _ (InnerLoopDecodeInit st _ p end)
762 return $ Skip $ OuterLoop st Nothing
763 step' _ _ (InnerLoopDecodeInit st contents p end) = do
764 x <- liftIO $ peekWith contents p
765 -- Note: It is important to use a ">" instead of a "<=" test here for
766 -- GHC to generate code layout for default branch prediction for the
767 -- common case. This is fragile and might change with the compiler
768 -- versions, we need a more reliable "likely" primitive to control
769 -- branch predication.
772 return $ Skip $ YAndC
773 (unsafeChr (fromIntegral x))
774 (InnerLoopDecodeInit st contents (p + 1) end)
775 -- Using a separate state here generates a jump to a separate code
776 -- block in the core which seems to perform slightly better for the
778 True -> return $ Skip $ InnerLoopDecodeFirst st contents p end x
780 step' table _ (InnerLoopDecodeFirst st contents p end x) = do
781 let (Tuple' sv cp) = decode0 table x
788 "Streamly.Internal.Data.Stream.StreamD."
789 ++ "decodeUtf8ArraysWith: Invalid UTF8"
790 ++ " codepoint encountered"
792 (InnerLoopDecodeInit st contents (p + 1) end)
793 0 -> error "unreachable state"
794 _ -> Skip (InnerLoopDecoding st contents (p + 1) end sv cp)
795 step' _ _ (InnerLoopDecoding st _ p end sv cp)
796 | p == end = return $ Skip $ OuterLoop st (Just (sv, cp))
797 step' table _ (InnerLoopDecoding st contents p end statePtr codepointPtr) = do
798 x <- liftIO $ peekWith contents p
799 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
806 (InnerLoopDecodeInit st contents (p + 1) end)
811 "Streamly.Internal.Data.Stream.StreamD."
812 ++ "decodeUtf8ArraysWith: Invalid UTF8"
813 ++ " codepoint encountered"
815 (InnerLoopDecodeInit st contents (p + 1) end)
818 (InnerLoopDecoding st contents (p + 1) end sv cp)
819 step' _ _ (YAndC c s) = return $ Yield c s
820 step' _ _ D = return Stop
822{-# INLINE decodeUtf8ArraysD #-}
825 => D.Stream m (Array Word8)
827decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure
832{-# INLINE decodeUtf8Arrays #-}
833decodeUtf8Arrays :: MonadIO m => Stream m (Array Word8) -> Stream m Char
835 fromStreamD . decodeUtf8ArraysD . toStreamD
837{-# INLINE decodeUtf8ArraysD' #-}
840 => D.Stream m (Array Word8)
842decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure
847{-# INLINE decodeUtf8Arrays' #-}
848decodeUtf8Arrays' :: MonadIO m => Stream m (Array Word8) -> Stream m Char
849decodeUtf8Arrays' = fromStreamD . decodeUtf8ArraysD' . toStreamD
851{-# INLINE decodeUtf8ArraysD_ #-}
854 => D.Stream m (Array Word8)
856decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure
861{-# INLINE decodeUtf8Arrays_ #-}
863 MonadIO m => Stream m (Array Word8) -> Stream m Char
865 fromStreamD . decodeUtf8ArraysD_ . toStreamD
867-------------------------------------------------------------------------------
868-- Encoding Unicode (UTF-8) Characters
869-------------------------------------------------------------------------------
871data WList = WCons !Word8 !WList | WNil
873-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
877ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
880 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
881 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
885ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
888 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
889 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
890 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
894ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
897 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
898 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
899 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
900 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
902{-# INLINE_NORMAL readCharUtf8With #-}
903readCharUtf8With :: Monad m => WList -> Unfold m Char Word8
904readCharUtf8With surr = Unfold step inject
909 return $ case ord c of
910 x | x <= 0x7F -> fromIntegral x `WCons` WNil
911 | x <= 0x7FF -> ord2 c
912 | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c
913 | otherwise -> ord4 c
915 {-# INLINE_LATE step #-}
916 step WNil = return Stop
917 step (WCons x xs) = return $ Yield x xs
919{-# INLINE_NORMAL readCharUtf8' #-}
920readCharUtf8' :: Monad m => Unfold m Char Word8
923 error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
925-- More yield points improve performance, but I am not sure if they can cause
926-- too much code bloat or some trouble with fusion. So keeping only two yield
927-- points for now, one for the ascii chars (fast path) and one for all other
929{-# INLINE_NORMAL encodeUtf8D' #-}
930encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8
931encodeUtf8D' = D.unfoldMany readCharUtf8'
933-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
934-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
935-- function errors out.
938{-# INLINE encodeUtf8' #-}
939encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8
940encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD
942{-# INLINE_NORMAL readCharUtf8 #-}
943readCharUtf8 :: Monad m => Unfold m Char Word8
944readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))
946-- | See section "3.9 Unicode Encoding Forms" in
947-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
949{-# INLINE_NORMAL encodeUtf8D #-}
950encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8
951encodeUtf8D = D.unfoldMany readCharUtf8
953-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
954-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
955-- Unicode replacement character U+FFFD.
957-- /Since: 0.7.0 ("Streamly.Data.Unicode.Stream")/
959-- /Since: 0.8.0 (Lenient Behaviour)/
960{-# INLINE encodeUtf8 #-}
961encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
962encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD
964{-# INLINE_NORMAL readCharUtf8_ #-}
965readCharUtf8_ :: Monad m => Unfold m Char Word8
966readCharUtf8_ = readCharUtf8With WNil
968{-# INLINE_NORMAL encodeUtf8D_ #-}
969encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8
970encodeUtf8D_ = D.unfoldMany readCharUtf8_
972-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
973-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
976{-# INLINE encodeUtf8_ #-}
977encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8
978encodeUtf8_ = fromStreamD . encodeUtf8D_ . toStreamD
980-- | Same as 'encodeUtf8'
982{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
983{-# INLINE encodeUtf8Lax #-}
984encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8
985encodeUtf8Lax = encodeUtf8
987-------------------------------------------------------------------------------
988-- Decoding string literals
989-------------------------------------------------------------------------------
991-- | Read UTF-8 encoded bytes as chars from an 'Addr#' until a 0 byte is
992-- encountered, the 0 byte is not included in the stream.
994-- /Unsafe:/ The caller is responsible for safe addressing.
996-- Note that this is completely safe when reading from Haskell string
997-- literals because they are guaranteed to be NULL terminated:
999-- >>> Stream.fold Fold.toList (Unicode.fromStr# "Haskell"#)
1002{-# INLINE fromStr# #-}
1003fromStr# :: MonadIO m => Addr# -> Stream m Char
1004fromStr# addr = decodeUtf8 $ Stream.fromByteStr# addr
1006-------------------------------------------------------------------------------
1007-- Encode streams of containers
1008-------------------------------------------------------------------------------
1010-- | Encode a container to @Array Word8@ provided an unfold to covert it to a
1011-- Char stream and an encoding function.
1014{-# INLINE encodeObject #-}
1015encodeObject :: MonadIO m =>
1016 (Stream m Char -> Stream m Word8)
1020encodeObject encode u = Stream.fold Array.write . encode . Stream.unfold u
1022-- | Encode a stream of container objects using the supplied encoding scheme.
1023-- Each object is encoded as an @Array Word8@.
1026{-# INLINE encodeObjects #-}
1027encodeObjects :: MonadIO m =>
1028 (Stream m Char -> Stream m Word8)
1031 -> Stream m (Array Word8)
1032encodeObjects encode u = Stream.mapM (encodeObject encode u)
1034-- | Encode a stream of 'String' using the supplied encoding scheme. Each
1035-- string is encoded as an @Array Word8@.
1038{-# INLINE encodeStrings #-}
1039encodeStrings :: MonadIO m =>
1040 (Stream m Char -> Stream m Word8)
1042 -> Stream m (Array Word8)
1043encodeStrings encode = encodeObjects encode Unfold.fromList
1046-------------------------------------------------------------------------------
1047-- Utility operations on strings
1048-------------------------------------------------------------------------------
1050strip :: IsStream t => Stream m Char -> Stream m Char
1053stripTail :: IsStream t => Stream m Char -> Stream m Char
1054stripTail = undefined
1057-- | Remove leading whitespace from a string.
1059-- > stripHead = Stream.dropWhile isSpace
1062{-# INLINE stripHead #-}
1063stripHead :: Monad m => Stream m Char -> Stream m Char
1064stripHead = Stream.dropWhile isSpace
1066-- | Fold each line of the stream using the supplied 'Fold'
1067-- and stream the result.
1069-- >>> Stream.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")
1070-- ["lines","this","string","",""]
1072-- > lines = Stream.splitOnSuffix (== '\n')
1076lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1077lines f = Stream.foldMany (Fold.takeEndBy_ (== '\n') f)
1079#if !MIN_VERSION_base(4,17,0)
1080foreign import ccall unsafe "u_iswspace"
1081 iswspace :: Int -> Int
1084-- | Code copied from base/Data.Char to INLINE it
1085{-# INLINE isSpace #-}
1086isSpace :: Char -> Bool
1088 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
1089#if MIN_VERSION_base(4,17,0)
1090 | otherwise = generalCategory c == Space
1092 | otherwise = iswspace (ord c) /= 0
1095 uc = fromIntegral (ord c) :: Word
1097-- | Fold each word of the stream using the supplied 'Fold'
1098-- and stream the result.
1100-- >>> Stream.toList $ words Fold.toList (Stream.fromList "fold these words")
1101-- ["fold","these","words"]
1103-- > words = Stream.wordsBy isSpace
1107words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1108words f m = Stream.fromStreamD $ D.wordsBy isSpace f (Stream.toStreamD m)
1110-- | Unfold a stream to character streams using the supplied 'Unfold'
1111-- and concat the results suffixing a newline character @\\n@ to each stream.
1114-- unlines = Stream.interposeSuffix '\n'
1115-- unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1119{-# INLINE unlines #-}
1120unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1121unlines = Stream.interposeSuffix '\n'
1123-- | Unfold the elements of a stream to character streams using the supplied
1124-- 'Unfold' and concat the results with a whitespace character infixed between
1128-- unwords = Stream.interpose ' '
1129-- unwords = Stream.intercalate Unfold.fromList " "
1133{-# INLINE unwords #-}
1134unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1135unwords = Stream.interpose ' '
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list