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.Type (Array(..))
107import Streamly.Internal.Data.Array.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.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.Data.Stream 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{-# INLINE decodeLatin1 #-}
144decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char
145decodeLatin1 = fmap (unsafeChr . fromIntegral)
147-------------------------------------------------------------------------------
149-------------------------------------------------------------------------------
151-- | Encode a stream of Unicode characters to bytes by mapping each character
152-- to a byte in 0-255 range. Throws an error if the input stream contains
153-- characters beyond 255.
155{-# INLINE encodeLatin1' #-}
156encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8
157encodeLatin1' = fmap convert
160 let codepoint = ord c
161 in if codepoint > 255
162 then error $ "Streamly.Unicode.encodeLatin1 invalid " ++
163 "input char codepoint " ++ show codepoint
164 else fromIntegral codepoint
166-- XXX Should we instead replace the invalid chars by NUL or whitespace or some
167-- other control char? That may affect the perf a bit but may be a better
170-- | Like 'encodeLatin1'' but silently maps input codepoints beyond 255 to
171-- arbitrary Latin1 chars in 0-255 range. No error or exception is thrown when
172-- such mapping occurs.
174{-# INLINE encodeLatin1 #-}
175encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8
176encodeLatin1 = fmap (fromIntegral . ord)
178-- | Like 'encodeLatin1' but drops the input characters beyond 255.
180{-# INLINE encodeLatin1_ #-}
181encodeLatin1_ :: Monad m => Stream m Char -> Stream m Word8
182encodeLatin1_ = fmap (fromIntegral . ord) . Stream.filter (<= chr 255)
184-- | Same as 'encodeLatin1'
186{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}
187{-# INLINE encodeLatin1Lax #-}
188encodeLatin1Lax :: Monad m => Stream m Char -> Stream m Word8
189encodeLatin1Lax = encodeLatin1
191-------------------------------------------------------------------------------
193-------------------------------------------------------------------------------
195-- Int helps in cheaper conversion from Int to Char
197type DecodeState = Word8
199-- We can divide the errors in three general categories:
200-- * A non-starter was encountered in a begin state
201-- * A starter was encountered without completing a codepoint
202-- * The last codepoint was not complete (input underflow)
204-- Need to separate resumable and non-resumable error. In case of non-resumable
205-- error we can also provide the failing byte. In case of resumable error the
206-- state can be opaque.
208data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
210-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
212-- XXX Use names decodeSuccess = 0, decodeFailure = 12
214decodeTable :: [Word8]
216 -- The first part of the table maps bytes to character classes that
217 -- to reduce the size of the transition table and create bitmasks.
218 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,
219 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,
220 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,
221 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,
222 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,
223 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,
224 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,
225 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,
227 -- The second part is a transition table that maps a combination
228 -- of a state of the automaton and a character class to a state.
229 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
230 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
231 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
232 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
233 12,36,12,12,12,12,12,12,12,12,12,12
236{-# INLINE utf8dLength #-}
238utf8dLength = length decodeTable
240-- | We do not want to garbage collect this and free the memory, we want to
241-- keep this persistent. We don't know how to do that with GHC without having a
242-- reference in some global structure. So we use a hack, use mallocBytes so
243-- that the GC has no way to free it.
244{-# NOINLINE utf8d #-}
246utf8d = unsafePerformIO $ do
247 let size = utf8dLength
248 p <- liftIO $ mallocBytes size
250 (Fold.foldlM' (\b a -> poke b a >> return (b `plusPtr` 1)) (return p))
251 (D.fromList decodeTable)
254-- | Return element at the specified index without checking the bounds.
255-- and without touching the foreign ptr.
256{-# INLINE_NORMAL unsafePeekElemOff #-}
257unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
258unsafePeekElemOff p i =
259 let !x = unsafeInlineIO $ peekElemOff p i
262-- XXX We can use a fromPtr stream to implement it.
263{-# INLINE showMemory #-}
265 forall a. (Show a, Storable a) => Ptr a -> Ptr a -> String
268 let cur1 = cur `plusPtr` sizeOf (undefined :: a)
269 in show (unsafeInlineIO $ peek cur) ++ " " ++ showMemory cur1 end
272-- decode is split into two separate cases to avoid branching instructions.
273-- From the higher level flow we already know which case we are in so we can
274-- call the appropriate decode function.
276-- When the state is 0
277{-# INLINE decode0 #-}
278decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
280 let !t = table `unsafePeekElemOff` fromIntegral byte
281 !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte
282 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
283 in assert ((byte > 0x7f || error showByte)
284 && (state' /= 0 || error (showByte ++ showTable)))
285 (Tuple' state' codep')
289 utf8tableEnd = table `plusPtr` 364
290 showByte = "Streamly: decode0: byte: " ++ show byte
291 showTable = " table: " ++ showMemory table utf8tableEnd
293-- When the state is not 0
294{-# INLINE decode1 #-}
300 -> Tuple' DecodeState CodePoint
301decode1 table state codep byte =
302 -- Remember codep is Int type!
303 -- Can it be unsafe to convert the resulting Int to Char?
304 let !t = table `unsafePeekElemOff` fromIntegral byte
305 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
306 !state' = table `unsafePeekElemOff`
307 (256 + fromIntegral state + fromIntegral t)
308 in assert (codep' <= 0x10FFFF
309 || error (showByte ++ showState state codep))
310 (Tuple' state' codep')
313 utf8tableEnd = table `plusPtr` 364
314 showByte = "Streamly: decode1: byte: " ++ show byte
316 " state: " ++ show st ++
317 " codepoint: " ++ show cp ++
318 " table: " ++ showMemory table utf8tableEnd
320-------------------------------------------------------------------------------
321-- Resumable UTF-8 decoding
322-------------------------------------------------------------------------------
324-- Strangely, GHCJS hangs linking template-haskell with this
326{-# ANN type UTF8DecodeState Fuse #-}
328data UTF8DecodeState s a
330 | UTF8DecodeInit1 s Word8
331 | UTF8DecodeFirst s Word8
332 | UTF8Decoding s !DecodeState !CodePoint
333 | YieldAndContinue a (UTF8DecodeState s a)
336{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
337resumeDecodeUtf8EitherD
342 -> D.Stream m (Either DecodeError Char)
343resumeDecodeUtf8EitherD dst codep (D.Stream step state) =
346 then UTF8DecodeInit state
347 else UTF8Decoding state dst codep
348 in D.Stream (step' utf8d) stt
350 {-# INLINE_LATE step' #-}
351 step' _ gst (UTF8DecodeInit st) = do
352 r <- step (adaptState gst) st
354 Yield x s -> Skip (UTF8DecodeInit1 s x)
355 Skip s -> Skip (UTF8DecodeInit s)
358 step' _ _ (UTF8DecodeInit1 st x) = do
359 -- Note: It is important to use a ">" instead of a "<=" test
360 -- here for GHC to generate code layout for default branch
361 -- prediction for the common case. This is fragile and might
362 -- change with the compiler versions, we need a more reliable
363 -- "likely" primitive to control branch predication.
366 return $ Skip $ YieldAndContinue
367 (Right $ unsafeChr (fromIntegral x))
369 -- Using a separate state here generates a jump to a
370 -- separate code block in the core which seems to perform
371 -- slightly better for the non-ascii case.
372 True -> return $ Skip $ UTF8DecodeFirst st x
374 -- XXX should we merge it with UTF8DecodeInit1?
375 step' table _ (UTF8DecodeFirst st x) = do
376 let (Tuple' sv cp) = decode0 table x
380 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
382 0 -> error "unreachable state"
383 _ -> Skip (UTF8Decoding st sv cp)
385 -- We recover by trying the new byte x a starter of a new codepoint.
386 -- XXX on error need to report the next byte "x" as well.
387 -- XXX need to use the same recovery in array decoding routine as well
388 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
389 r <- step (adaptState gst) st
392 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
395 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
398 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
399 (UTF8DecodeInit1 s x)
400 _ -> Skip (UTF8Decoding s sv cp)
401 Skip s -> return $ Skip (UTF8Decoding s statePtr codepointPtr)
402 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
404 step' _ _ (YieldAndContinue c s) = return $ Yield c s
405 step' _ _ Done = return Stop
407-- XXX We can use just one API, and define InitState = 0 and InitCodePoint = 0
408-- to use as starting state.
410{-# INLINE_NORMAL decodeUtf8EitherD #-}
411decodeUtf8EitherD :: Monad m
412 => D.Stream m Word8 -> D.Stream m (Either DecodeError Char)
413decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
418{-# INLINE decodeUtf8Either #-}
419decodeUtf8Either :: Monad m
420 => Stream m Word8 -> Stream m (Either DecodeError Char)
421decodeUtf8Either = fromStreamD . decodeUtf8EitherD . toStreamD
426{-# INLINE resumeDecodeUtf8Either #-}
427resumeDecodeUtf8Either
432 -> Stream m (Either DecodeError Char)
433resumeDecodeUtf8Either st cp =
434 fromStreamD . resumeDecodeUtf8EitherD st cp . toStreamD
436-------------------------------------------------------------------------------
438-------------------------------------------------------------------------------
440data CodingFailureMode
441 = TransliterateCodingFailure
442 | ErrorOnCodingFailure
443 | DropOnCodingFailure
446{-# INLINE replacementChar #-}
447replacementChar :: Char
448replacementChar = '\xFFFD'
450data UTF8CharDecodeState a
452 | UTF8CharDecoding !DecodeState !CodePoint
454{-# INLINE parseCharUtf8WithD #-}
456 MonadThrow m => CodingFailureMode -> ParserD.Parser Word8 m Char
457parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract
461 prefix = "Streamly.Internal.Data.Stream.parseCharUtf8WithD:"
463 {-# INLINE initial #-}
464 initial = return $ ParserD.IPartial UTF8CharDecodeInit
466 handleError err souldBackTrack =
468 ErrorOnCodingFailure -> ParserD.Error err
469 TransliterateCodingFailure ->
470 case souldBackTrack of
471 True -> ParserD.Done 1 replacementChar
472 False -> ParserD.Done 0 replacementChar
473 DropOnCodingFailure ->
474 case souldBackTrack of
475 True -> ParserD.Continue 1 UTF8CharDecodeInit
476 False -> ParserD.Continue 0 UTF8CharDecodeInit
479 step' table UTF8CharDecodeInit x =
480 -- Note: It is important to use a ">" instead of a "<=" test
481 -- here for GHC to generate code layout for default branch
482 -- prediction for the common case. This is fragile and might
483 -- change with the compiler versions, we need a more reliable
484 -- "likely" primitive to control branch predication.
485 return $ case x > 0x7f of
486 False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x
488 let (Tuple' sv cp) = decode0 table x
492 ++ "Invalid first UTF8 byte" ++ show x
493 in handleError msg False
494 0 -> error $ prefix ++ "unreachable state"
495 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
497 step' table (UTF8CharDecoding statePtr codepointPtr) x = return $
498 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
500 0 -> ParserD.Done 0 $ unsafeChr cp
503 ++ "Invalid subsequent UTF8 byte"
507 ++ "accumulated value"
509 in handleError msg True
510 _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)
512 {-# INLINE extract #-}
513 extract UTF8CharDecodeInit = error $ prefix ++ "Not enough input"
514 extract (UTF8CharDecoding _ _) =
516 ErrorOnCodingFailure ->
517 return $ ParserD.Error $ prefix ++ "Not enough input"
518 TransliterateCodingFailure ->
519 return (ParserD.Done 0 replacementChar)
520 -- XXX We shouldn't error out here. There is no way to represent an
521 -- empty parser result unless we return a "Maybe" type.
522 DropOnCodingFailure -> error $ prefix ++ "Not enough input"
524-- XXX This should ideally accept a "CodingFailureMode" and perform appropriate
525-- error handling. This isn't possible now as "TransliterateCodingFailure"'s
526-- workflow requires backtracking 1 element. This can be revisited once "Fold"
527-- supports backtracking.
528{-# INLINE writeCharUtf8' #-}
529writeCharUtf8' :: MonadThrow m => Fold m Word8 Char
530writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)
532-- XXX The initial idea was to have "parseCharUtf8" and offload the error
533-- handling to another parser. So, say we had "parseCharUtf8'",
535-- >>> parseCharUtf8Smart = parseCharUtf8' <|> Parser.fromPure replacementChar
537-- But unfortunately parseCharUtf8Smart used in conjunction with "parseMany" -
538-- that is "parseMany parseCharUtf8Smart" on a stream causes the heap to
539-- overflow. Even a heap size of 500 MB was not sufficient.
541-- This needs to be investigated futher.
542{-# INLINE parseCharUtf8With #-}
544 MonadCatch m => CodingFailureMode -> Parser.Parser Word8 m Char
545parseCharUtf8With = ParserD.toParserK . parseCharUtf8WithD
547-- XXX write it as a parser and use parseMany to decode a stream, need to check
548-- if that preserves the same performance. Or we can use a resumable parser
549-- that parses a chunk at a time.
551-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that
552-- decodeUtf8Either preserves the performance characterstics.
554{-# INLINE_NORMAL decodeUtf8WithD #-}
555decodeUtf8WithD :: Monad m
556 => CodingFailureMode -> D.Stream m Word8 -> D.Stream m Char
557decodeUtf8WithD cfm (D.Stream step state) =
558 D.Stream (step' utf8d) (UTF8DecodeInit state)
562 prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "
564 {-# INLINE handleError #-}
567 ErrorOnCodingFailure -> error e
568 TransliterateCodingFailure -> YieldAndContinue replacementChar s
569 DropOnCodingFailure -> s
571 {-# INLINE handleUnderflow #-}
574 ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"
575 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
576 DropOnCodingFailure -> Done
578 {-# INLINE_LATE step' #-}
579 step' _ gst (UTF8DecodeInit st) = do
580 r <- step (adaptState gst) st
582 Yield x s -> Skip (UTF8DecodeInit1 s x)
583 Skip s -> Skip (UTF8DecodeInit s)
586 step' _ _ (UTF8DecodeInit1 st x) = do
587 -- Note: It is important to use a ">" instead of a "<=" test
588 -- here for GHC to generate code layout for default branch
589 -- prediction for the common case. This is fragile and might
590 -- change with the compiler versions, we need a more reliable
591 -- "likely" primitive to control branch predication.
594 return $ Skip $ YieldAndContinue
595 (unsafeChr (fromIntegral x))
597 -- Using a separate state here generates a jump to a
598 -- separate code block in the core which seems to perform
599 -- slightly better for the non-ascii case.
600 True -> return $ Skip $ UTF8DecodeFirst st x
602 -- XXX should we merge it with UTF8DecodeInit1?
603 step' table _ (UTF8DecodeFirst st x) = do
604 let (Tuple' sv cp) = decode0 table x
608 let msg = prefix ++ "Invalid first UTF8 byte " ++ show x
609 in Skip $ handleError msg (UTF8DecodeInit st)
610 0 -> error "unreachable state"
611 _ -> Skip (UTF8Decoding st sv cp)
613 -- We recover by trying the new byte x as a starter of a new codepoint.
614 -- XXX need to use the same recovery in array decoding routine as well
615 step' table gst (UTF8Decoding st statePtr codepointPtr) = do
616 r <- step (adaptState gst) st
619 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
621 0 -> Skip $ YieldAndContinue
622 (unsafeChr cp) (UTF8DecodeInit s)
625 ++ "Invalid subsequent UTF8 byte "
629 ++ " accumulated value "
631 in Skip $ handleError msg (UTF8DecodeInit1 s x)
632 _ -> Skip (UTF8Decoding s sv cp)
634 Skip (UTF8Decoding s statePtr codepointPtr)
635 Stop -> return $ Skip handleUnderflow
637 step' _ _ (YieldAndContinue c s) = return $ Yield c s
638 step' _ _ Done = return Stop
640{-# INLINE decodeUtf8D #-}
641decodeUtf8D :: Monad m => D.Stream m Word8 -> D.Stream m Char
642decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure
644-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
645-- Any invalid codepoint encountered is replaced with the unicode replacement
648{-# INLINE decodeUtf8 #-}
649decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char
650decodeUtf8 = fromStreamD . decodeUtf8D . toStreamD
652{-# INLINE decodeUtf8D' #-}
653decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char
654decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure
656-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
657-- The function throws an error if an invalid codepoint is encountered.
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 DropOnCodingFailure
667-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
668-- Any invalid codepoint encountered is dropped.
670{-# INLINE decodeUtf8_ #-}
671decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char
672decodeUtf8_ = fromStreamD . decodeUtf8D_ . toStreamD
674-- | Same as 'decodeUtf8'
676{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}
677{-# INLINE decodeUtf8Lax #-}
678decodeUtf8Lax :: Monad m => Stream m Word8 -> Stream m Char
679decodeUtf8Lax = decodeUtf8
681-------------------------------------------------------------------------------
682-- Decoding Array Streams
683-------------------------------------------------------------------------------
686{-# ANN type FlattenState Fuse #-}
689 = OuterLoop s !(Maybe (DecodeState, CodePoint))
690 | InnerLoopDecodeInit s (MutableByteArray a) !Int !Int
691 | InnerLoopDecodeFirst s (MutableByteArray a) !Int !Int Word8
692 | InnerLoopDecoding s (MutableByteArray a) !Int !Int
693 !DecodeState !CodePoint
694 | YAndC !Char (FlattenState s a) -- These constructors can be
695 -- encoded in the UTF8DecodeState
696 -- type, I prefer to keep these
697 -- flat even though that means
698 -- coming up with new names
701-- The normal decodeUtf8 above should fuse with flattenArrays
702-- to create this exact code but it doesn't for some reason, as of now this
703-- remains the fastest way I could figure out to decodeUtf8.
705-- XXX Add Proper error messages
706{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
707decodeUtf8ArraysWithD ::
710 -> D.Stream m (Array Word8)
712decodeUtf8ArraysWithD cfm (D.Stream step state) =
713 D.Stream (step' utf8d) (OuterLoop state Nothing)
715 {-# INLINE transliterateOrError #-}
716 transliterateOrError e s =
718 ErrorOnCodingFailure -> error e
719 TransliterateCodingFailure -> YAndC replacementChar s
720 DropOnCodingFailure -> s
721 {-# INLINE inputUnderflow #-}
724 ErrorOnCodingFailure ->
726 show "Streamly.Internal.Data.Stream.StreamD."
727 ++ "decodeUtf8ArraysWith: Input Underflow"
728 TransliterateCodingFailure -> YAndC replacementChar D
729 DropOnCodingFailure -> D
730 {-# INLINE_LATE step' #-}
731 step' _ gst (OuterLoop st Nothing) = do
732 r <- step (adaptState gst) st
735 Yield Array {..} s ->
736 Skip (InnerLoopDecodeInit s arrContents arrStart arrEnd)
737 Skip s -> Skip (OuterLoop s Nothing)
739 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
740 r <- step (adaptState gst) st
743 Yield Array {..} s ->
744 Skip (InnerLoopDecoding s arrContents arrStart arrEnd ds cp)
745 Skip s -> Skip (OuterLoop s dst)
746 Stop -> Skip inputUnderflow
747 step' _ _ (InnerLoopDecodeInit st _ p end)
749 return $ Skip $ OuterLoop st Nothing
750 step' _ _ (InnerLoopDecodeInit st contents p end) = do
751 x <- liftIO $ peekWith contents p
752 -- Note: It is important to use a ">" instead of a "<=" test here for
753 -- GHC to generate code layout for default branch prediction for the
754 -- common case. This is fragile and might change with the compiler
755 -- versions, we need a more reliable "likely" primitive to control
756 -- branch predication.
759 return $ Skip $ YAndC
760 (unsafeChr (fromIntegral x))
761 (InnerLoopDecodeInit st contents (p + 1) end)
762 -- Using a separate state here generates a jump to a separate code
763 -- block in the core which seems to perform slightly better for the
765 True -> return $ Skip $ InnerLoopDecodeFirst st contents p end x
767 step' table _ (InnerLoopDecodeFirst st contents p end x) = do
768 let (Tuple' sv cp) = decode0 table x
775 "Streamly.Internal.Data.Stream.StreamD."
776 ++ "decodeUtf8ArraysWith: Invalid UTF8"
777 ++ " codepoint encountered"
779 (InnerLoopDecodeInit st contents (p + 1) end)
780 0 -> error "unreachable state"
781 _ -> Skip (InnerLoopDecoding st contents (p + 1) end sv cp)
782 step' _ _ (InnerLoopDecoding st _ p end sv cp)
783 | p == end = return $ Skip $ OuterLoop st (Just (sv, cp))
784 step' table _ (InnerLoopDecoding st contents p end statePtr codepointPtr) = do
785 x <- liftIO $ peekWith contents p
786 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
793 (InnerLoopDecodeInit st contents (p + 1) end)
798 "Streamly.Internal.Data.Stream.StreamD."
799 ++ "decodeUtf8ArraysWith: Invalid UTF8"
800 ++ " codepoint encountered"
802 (InnerLoopDecodeInit st contents (p + 1) end)
805 (InnerLoopDecoding st contents (p + 1) end sv cp)
806 step' _ _ (YAndC c s) = return $ Yield c s
807 step' _ _ D = return Stop
809{-# INLINE decodeUtf8ArraysD #-}
812 => D.Stream m (Array Word8)
814decodeUtf8ArraysD = decodeUtf8ArraysWithD TransliterateCodingFailure
819{-# INLINE decodeUtf8Arrays #-}
820decodeUtf8Arrays :: MonadIO m => Stream m (Array Word8) -> Stream m Char
822 fromStreamD . decodeUtf8ArraysD . toStreamD
824{-# INLINE decodeUtf8ArraysD' #-}
827 => D.Stream m (Array Word8)
829decodeUtf8ArraysD' = decodeUtf8ArraysWithD ErrorOnCodingFailure
834{-# INLINE decodeUtf8Arrays' #-}
835decodeUtf8Arrays' :: MonadIO m => Stream m (Array Word8) -> Stream m Char
836decodeUtf8Arrays' = fromStreamD . decodeUtf8ArraysD' . toStreamD
838{-# INLINE decodeUtf8ArraysD_ #-}
841 => D.Stream m (Array Word8)
843decodeUtf8ArraysD_ = decodeUtf8ArraysWithD DropOnCodingFailure
848{-# INLINE decodeUtf8Arrays_ #-}
850 MonadIO m => Stream m (Array Word8) -> Stream m Char
852 fromStreamD . decodeUtf8ArraysD_ . toStreamD
854-------------------------------------------------------------------------------
855-- Encoding Unicode (UTF-8) Characters
856-------------------------------------------------------------------------------
858data WList = WCons !Word8 !WList | WNil
860-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
864ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
867 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
868 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
872ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
875 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
876 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
877 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
881ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
884 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
885 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
886 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
887 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
889{-# INLINE_NORMAL readCharUtf8With #-}
890readCharUtf8With :: Monad m => WList -> Unfold m Char Word8
891readCharUtf8With surr = Unfold step inject
896 return $ case ord c of
897 x | x <= 0x7F -> fromIntegral x `WCons` WNil
898 | x <= 0x7FF -> ord2 c
899 | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c
900 | otherwise -> ord4 c
902 {-# INLINE_LATE step #-}
903 step WNil = return Stop
904 step (WCons x xs) = return $ Yield x xs
906{-# INLINE_NORMAL readCharUtf8' #-}
907readCharUtf8' :: Monad m => Unfold m Char Word8
910 error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"
912-- More yield points improve performance, but I am not sure if they can cause
913-- too much code bloat or some trouble with fusion. So keeping only two yield
914-- points for now, one for the ascii chars (fast path) and one for all other
916{-# INLINE_NORMAL encodeUtf8D' #-}
917encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8
918encodeUtf8D' = D.unfoldMany readCharUtf8'
920-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When
921-- any invalid character (U+D800-U+D8FF) is encountered in the input stream the
922-- function errors out.
924{-# INLINE encodeUtf8' #-}
925encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8
926encodeUtf8' = fromStreamD . encodeUtf8D' . toStreamD
928{-# INLINE_NORMAL readCharUtf8 #-}
929readCharUtf8 :: Monad m => Unfold m Char Word8
930readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))
932-- | See section "3.9 Unicode Encoding Forms" in
933-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf
935{-# INLINE_NORMAL encodeUtf8D #-}
936encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8
937encodeUtf8D = D.unfoldMany readCharUtf8
939-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
940-- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the
941-- Unicode replacement character U+FFFD.
943{-# INLINE encodeUtf8 #-}
944encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8
945encodeUtf8 = fromStreamD . encodeUtf8D . toStreamD
947{-# INLINE_NORMAL readCharUtf8_ #-}
948readCharUtf8_ :: Monad m => Unfold m Char Word8
949readCharUtf8_ = readCharUtf8With WNil
951{-# INLINE_NORMAL encodeUtf8D_ #-}
952encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8
953encodeUtf8D_ = D.unfoldMany readCharUtf8_
955-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any
956-- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.
958{-# INLINE encodeUtf8_ #-}
959encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8
960encodeUtf8_ = fromStreamD . encodeUtf8D_ . toStreamD
962-- | Same as 'encodeUtf8'
964{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}
965{-# INLINE encodeUtf8Lax #-}
966encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8
967encodeUtf8Lax = encodeUtf8
969-------------------------------------------------------------------------------
970-- Decoding string literals
971-------------------------------------------------------------------------------
973-- | Read UTF-8 encoded bytes as chars from an 'Addr#' until a 0 byte is
974-- encountered, the 0 byte is not included in the stream.
976-- /Unsafe:/ The caller is responsible for safe addressing.
978-- Note that this is completely safe when reading from Haskell string
979-- literals because they are guaranteed to be NULL terminated:
981-- >>> Stream.fold Fold.toList (Unicode.fromStr# "Haskell"#)
984{-# INLINE fromStr# #-}
985fromStr# :: MonadIO m => Addr# -> Stream m Char
986fromStr# addr = decodeUtf8 $ Stream.fromByteStr# addr
988-------------------------------------------------------------------------------
989-- Encode streams of containers
990-------------------------------------------------------------------------------
992-- | Encode a container to @Array Word8@ provided an unfold to covert it to a
993-- Char stream and an encoding function.
996{-# INLINE encodeObject #-}
997encodeObject :: MonadIO m =>
998 (Stream m Char -> Stream m Word8)
1002encodeObject encode u = Stream.fold Array.write . encode . Stream.unfold u
1004-- | Encode a stream of container objects using the supplied encoding scheme.
1005-- Each object is encoded as an @Array Word8@.
1008{-# INLINE encodeObjects #-}
1009encodeObjects :: MonadIO m =>
1010 (Stream m Char -> Stream m Word8)
1013 -> Stream m (Array Word8)
1014encodeObjects encode u = Stream.mapM (encodeObject encode u)
1016-- | Encode a stream of 'String' using the supplied encoding scheme. Each
1017-- string is encoded as an @Array Word8@.
1019{-# INLINE encodeStrings #-}
1020encodeStrings :: MonadIO m =>
1021 (Stream m Char -> Stream m Word8)
1023 -> Stream m (Array Word8)
1024encodeStrings encode = encodeObjects encode Unfold.fromList
1027-------------------------------------------------------------------------------
1028-- Utility operations on strings
1029-------------------------------------------------------------------------------
1031strip :: IsStream t => Stream m Char -> Stream m Char
1034stripTail :: IsStream t => Stream m Char -> Stream m Char
1035stripTail = undefined
1038-- | Remove leading whitespace from a string.
1040-- > stripHead = Stream.dropWhile isSpace
1043{-# INLINE stripHead #-}
1044stripHead :: Monad m => Stream m Char -> Stream m Char
1045stripHead = Stream.dropWhile isSpace
1047-- | Fold each line of the stream using the supplied 'Fold'
1048-- and stream the result.
1050-- >>> Stream.fold Fold.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")
1051-- ["lines","this","string","",""]
1053-- > lines = Stream.splitOnSuffix (== '\n')
1057lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1058lines f = Stream.foldMany (Fold.takeEndBy_ (== '\n') f)
1060#if !MIN_VERSION_base(4,17,0)
1061foreign import ccall unsafe "u_iswspace"
1062 iswspace :: Int -> Int
1065-- | Code copied from base/Data.Char to INLINE it
1066{-# INLINE isSpace #-}
1067isSpace :: Char -> Bool
1069 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
1070#if MIN_VERSION_base(4,17,0)
1071 | otherwise = generalCategory c == Space
1073 | otherwise = iswspace (ord c) /= 0
1076 uc = fromIntegral (ord c) :: Word
1078-- | Fold each word of the stream using the supplied 'Fold'
1079-- and stream the result.
1081-- >>> Stream.fold Fold.toList $ words Fold.toList (Stream.fromList "fold these words")
1082-- ["fold","these","words"]
1084-- > words = Stream.wordsBy isSpace
1088words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b
1089words f m = Stream.fromStreamD $ D.wordsBy isSpace f (Stream.toStreamD m)
1091-- | Unfold a stream to character streams using the supplied 'Unfold'
1092-- and concat the results suffixing a newline character @\\n@ to each stream.
1095-- unlines = Stream.interposeSuffix '\n'
1096-- unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1100{-# INLINE unlines #-}
1101unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1102unlines = Stream.interposeSuffix '\n'
1104-- | Unfold the elements of a stream to character streams using the supplied
1105-- 'Unfold' and concat the results with a whitespace character infixed between
1109-- unwords = Stream.interpose ' '
1110-- unwords = Stream.intercalate Unfold.fromList " "
1114{-# INLINE unwords #-}
1115unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char
1116unwords = 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