git.iko.soy/streamly
on 33b00a6 help sign in
streamly/src/Streamly/Internal/Data/Unicode/Stream.hs
744 lines 28 kB history raw
1{-# OPTIONS_HADDOCK hide #-}
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE CPP #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE PatternSynonyms #-}
6{-# LANGUAGE RankNTypes #-}
7{-# LANGUAGE RecordWildCards #-}
9-- |
10-- Module : Streamly.Data.Internal.Unicode.Stream
11-- Copyright : (c) 2018 Composewell Technologies
12--
13-- License : BSD3
14-- Maintainer : streamly@composewell.com
15-- Stability : experimental
16-- Portability : GHC
17--
19#include "inline.hs"
21module Streamly.Internal.Data.Unicode.Stream
22 (
23 -- * Construction (Decoding)
24 decodeLatin1
25 , decodeUtf8
26 , decodeUtf8Lax
27 , DecodeError(..)
28 , DecodeState
29 , CodePoint
30 , decodeUtf8Either
31 , resumeDecodeUtf8Either
32 , decodeUtf8Arrays
33 , decodeUtf8ArraysLenient
35 -- * Elimination (Encoding)
36 , encodeLatin1
37 , encodeLatin1Lax
38 , encodeUtf8
39 {-
40 -- * Operations on character strings
41 , strip -- (dropAround isSpace)
42 , stripEnd
43 -}
45 -- * StreamD UTF8 Encoding / Decoding transformations.
46 , decodeUtf8D
47 , encodeUtf8D
48 , decodeUtf8LenientD
49 , decodeUtf8EitherD
50 , resumeDecodeUtf8EitherD
51 , decodeUtf8ArraysD
52 , decodeUtf8ArraysLenientD
54 -- * Transformation
55 , stripStart
56 , lines
57 , words
58 , unlines
59 , unwords
60 )
61where
63import Control.Monad.IO.Class (MonadIO, liftIO)
64import Data.Bits (shiftR, shiftL, (.|.), (.&.))
65import Data.Char (ord)
66import Data.Word (Word8)
67import Foreign.ForeignPtr (touchForeignPtr)
68import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
69import Foreign.Storable (Storable(..))
70import GHC.Base (assert, unsafeChr)
71import GHC.ForeignPtr (ForeignPtr (..))
72import GHC.IO.Encoding.Failure (isSurrogate)
73import GHC.Ptr (Ptr (..), plusPtr)
74import Prelude hiding (String, lines, words, unlines, unwords)
75import System.IO.Unsafe (unsafePerformIO)
77import Streamly (IsStream)
78import Streamly.Data.Fold (Fold)
79import Streamly.Memory.Array (Array)
80import Streamly.Internal.Data.Unfold (Unfold)
81import Streamly.Internal.Data.SVar (adaptState)
82import Streamly.Internal.Data.Stream.StreamD (Stream(..), Step (..))
83import Streamly.Internal.Data.Strict (Tuple'(..))
85#if __GLASGOW_HASKELL__ < 800
86import Streamly.Internal.Data.Stream.StreamD (pattern Stream)
87#endif
89import qualified Streamly.Internal.Memory.Array.Types as A
90import qualified Streamly.Internal.Prelude as S
91import qualified Streamly.Internal.Data.Stream.StreamD as D
93-------------------------------------------------------------------------------
94-- Encoding/Decoding Unicode (UTF-8) Characters
95-------------------------------------------------------------------------------
97-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.
99data WList = WCons !Word8 !WList | WNil
101{-# INLINE ord2 #-}
102ord2 :: Char -> WList
103ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))
104 where
105 n = ord c
106 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0
107 x2 = fromIntegral $ (n .&. 0x3F) + 0x80
109{-# INLINE ord3 #-}
110ord3 :: Char -> WList
111ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))
112 where
113 n = ord c
114 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0
115 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
116 x3 = fromIntegral $ (n .&. 0x3F) + 0x80
118{-# INLINE ord4 #-}
119ord4 :: Char -> WList
120ord4 c = assert (n >= 0x10000) (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))
121 where
122 n = ord c
123 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0
124 x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80
125 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80
126 x4 = fromIntegral $ (n .&. 0x3F) + 0x80
128data CodingFailureMode
129 = TransliterateCodingFailure
130 | ErrorOnCodingFailure
131 deriving (Show)
133{-# INLINE replacementChar #-}
134replacementChar :: Char
135replacementChar = '\xFFFD'
137-- Int helps in cheaper conversion from Int to Char
138type CodePoint = Int
139type DecodeState = Word8
141-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.
143-- XXX Use names decodeSuccess = 0, decodeFailure = 12
145decodeTable :: [Word8]
146decodeTable = [
147 -- The first part of the table maps bytes to character classes that
148 -- to reduce the size of the transition table and create bitmasks.
149 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,
150 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,
151 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,
152 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,
153 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,
154 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,
155 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,
156 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,
158 -- The second part is a transition table that maps a combination
159 -- of a state of the automaton and a character class to a state.
160 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,
161 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,
162 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,
163 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,
164 12,36,12,12,12,12,12,12,12,12,12,12
165 ]
167utf8d :: A.Array Word8
168utf8d =
169 unsafePerformIO
170 -- Aligning to cacheline makes a barely noticeable difference
171 -- XXX currently alignment is not implemented for unmanaged allocation
172 $ D.runFold (A.writeNAlignedUnmanaged 64 (length decodeTable))
173 (D.fromList decodeTable)
175-- | Return element at the specified index without checking the bounds.
176-- and without touching the foreign ptr.
177{-# INLINE_NORMAL unsafePeekElemOff #-}
178unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a
179unsafePeekElemOff p i = let !x = A.unsafeInlineIO $ peekElemOff p i in x
181-- decode is split into two separate cases to avoid branching instructions.
182-- From the higher level flow we already know which case we are in so we can
183-- call the appropriate decode function.
184--
185-- When the state is 0
186{-# INLINE decode0 #-}
187decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint
188decode0 table byte =
189 let !t = table `unsafePeekElemOff` fromIntegral byte
190 !codep' = (0xff `shiftR` (fromIntegral t)) .&. fromIntegral byte
191 !state' = table `unsafePeekElemOff` (256 + fromIntegral t)
192 in assert ((byte > 0x7f || error showByte)
193 && (state' /= 0 || error (showByte ++ showTable)))
194 (Tuple' state' codep')
196 where
198 utf8table =
199 let !(Ptr addr) = table
200 end = table `plusPtr` 364
201 in A.Array (ForeignPtr addr undefined) end end :: A.Array Word8
202 showByte = "Streamly: decode0: byte: " ++ show byte
203 showTable = " table: " ++ show utf8table
205-- When the state is not 0
206{-# INLINE decode1 #-}
207decode1
208 :: Ptr Word8
209 -> DecodeState
210 -> CodePoint
211 -> Word8
212 -> Tuple' DecodeState CodePoint
213decode1 table state codep byte =
214 -- Remember codep is Int type!
215 -- Can it be unsafe to convert the resulting Int to Char?
216 let !t = table `unsafePeekElemOff` fromIntegral byte
217 !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)
218 !state' = table `unsafePeekElemOff`
219 (256 + fromIntegral state + fromIntegral t)
220 in assert (codep' <= 0x10FFFF
221 || error (showByte ++ showState state codep))
222 (Tuple' state' codep')
223 where
225 utf8table =
226 let !(Ptr addr) = table
227 end = table `plusPtr` 364
228 in A.Array (ForeignPtr addr undefined) end end :: A.Array Word8
229 showByte = "Streamly: decode1: byte: " ++ show byte
230 showState st cp =
231 " state: " ++ show st ++
232 " codepoint: " ++ show cp ++
233 " table: " ++ show utf8table
235-- We can divide the errors in three general categories:
236-- * A non-starter was encountered in a begin state
237-- * A starter was encountered without completing a codepoint
238-- * The last codepoint was not complete (input underflow)
239--
240data DecodeError = DecodeError !DecodeState !CodePoint deriving Show
242data FreshPoint s a
243 = FreshPointDecodeInit s
244 | FreshPointDecodeInit1 s Word8
245 | FreshPointDecodeFirst s Word8
246 | FreshPointDecoding s !DecodeState !CodePoint
247 | YieldAndContinue a (FreshPoint s a)
248 | Done
250-- XXX Add proper error messages
251-- XXX Implement this in terms of decodeUtf8Either
252{-# INLINE_NORMAL decodeUtf8WithD #-}
253decodeUtf8WithD :: Monad m => CodingFailureMode -> Stream m Word8 -> Stream m Char
254decodeUtf8WithD cfm (Stream step state) =
255 let A.Array p _ _ = utf8d
256 !ptr = (unsafeForeignPtrToPtr p)
257 in Stream (step' ptr) (FreshPointDecodeInit state)
258 where
259 {-# INLINE transliterateOrError #-}
260 transliterateOrError e s =
261 case cfm of
262 ErrorOnCodingFailure -> error e
263 TransliterateCodingFailure -> YieldAndContinue replacementChar s
264 {-# INLINE inputUnderflow #-}
265 inputUnderflow =
266 case cfm of
267 ErrorOnCodingFailure ->
268 error "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Input Underflow"
269 TransliterateCodingFailure -> YieldAndContinue replacementChar Done
270 {-# INLINE_LATE step' #-}
271 step' _ gst (FreshPointDecodeInit st) = do
272 r <- step (adaptState gst) st
273 return $ case r of
274 Yield x s -> Skip (FreshPointDecodeInit1 s x)
275 Skip s -> Skip (FreshPointDecodeInit s)
276 Stop -> Skip Done
278 step' _ _ (FreshPointDecodeInit1 st x) = do
279 -- Note: It is important to use a ">" instead of a "<=" test
280 -- here for GHC to generate code layout for default branch
281 -- prediction for the common case. This is fragile and might
282 -- change with the compiler versions, we need a more reliable
283 -- "likely" primitive to control branch predication.
284 case x > 0x7f of
285 False ->
286 return $ Skip $ YieldAndContinue
287 (unsafeChr (fromIntegral x))
288 (FreshPointDecodeInit st)
289 -- Using a separate state here generates a jump to a
290 -- separate code block in the core which seems to perform
291 -- slightly better for the non-ascii case.
292 True -> return $ Skip $ FreshPointDecodeFirst st x
294 -- XXX should we merge it with FreshPointDecodeInit1?
295 step' table _ (FreshPointDecodeFirst st x) = do
296 let (Tuple' sv cp) = decode0 table x
297 return $
298 case sv of
299 12 ->
300 Skip $
301 transliterateOrError
302 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
303 (FreshPointDecodeInit st)
304 0 -> error "unreachable state"
305 _ -> Skip (FreshPointDecoding st sv cp)
307 -- We recover by trying the new byte x a starter of a new codepoint.
308 -- XXX need to use the same recovery in array decoding routine as well
309 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
310 r <- step (adaptState gst) st
311 case r of
312 Yield x s -> do
313 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
314 return $
315 case sv of
316 0 -> Skip $ YieldAndContinue (unsafeChr cp)
317 (FreshPointDecodeInit s)
318 12 ->
319 Skip $
320 transliterateOrError
321 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: Invalid UTF8 codepoint encountered"
322 (FreshPointDecodeInit1 s x)
323 _ -> Skip (FreshPointDecoding s sv cp)
324 Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
325 Stop -> return $ Skip inputUnderflow
327 step' _ _ (YieldAndContinue c s) = return $ Yield c s
328 step' _ _ Done = return Stop
330{-# INLINE decodeUtf8D #-}
331decodeUtf8D :: Monad m => Stream m Word8 -> Stream m Char
332decodeUtf8D = decodeUtf8WithD ErrorOnCodingFailure
334{-# INLINE decodeUtf8LenientD #-}
335decodeUtf8LenientD :: Monad m => Stream m Word8 -> Stream m Char
336decodeUtf8LenientD = decodeUtf8WithD TransliterateCodingFailure
338{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}
339resumeDecodeUtf8EitherD
340 :: Monad m
341 => DecodeState
342 -> CodePoint
343 -> Stream m Word8
344 -> Stream m (Either DecodeError Char)
345resumeDecodeUtf8EitherD dst codep (Stream step state) =
346 let A.Array p _ _ = utf8d
347 !ptr = (unsafeForeignPtrToPtr p)
348 stt =
349 if dst == 0
350 then FreshPointDecodeInit state
351 else FreshPointDecoding state dst codep
352 in Stream (step' ptr) stt
353 where
354 {-# INLINE_LATE step' #-}
355 step' _ gst (FreshPointDecodeInit st) = do
356 r <- step (adaptState gst) st
357 return $ case r of
358 Yield x s -> Skip (FreshPointDecodeInit1 s x)
359 Skip s -> Skip (FreshPointDecodeInit s)
360 Stop -> Skip Done
362 step' _ _ (FreshPointDecodeInit1 st x) = do
363 -- Note: It is important to use a ">" instead of a "<=" test
364 -- here for GHC to generate code layout for default branch
365 -- prediction for the common case. This is fragile and might
366 -- change with the compiler versions, we need a more reliable
367 -- "likely" primitive to control branch predication.
368 case x > 0x7f of
369 False ->
370 return $ Skip $ YieldAndContinue
371 (Right $ unsafeChr (fromIntegral x))
372 (FreshPointDecodeInit st)
373 -- Using a separate state here generates a jump to a
374 -- separate code block in the core which seems to perform
375 -- slightly better for the non-ascii case.
376 True -> return $ Skip $ FreshPointDecodeFirst st x
378 -- XXX should we merge it with FreshPointDecodeInit1?
379 step' table _ (FreshPointDecodeFirst st x) = do
380 let (Tuple' sv cp) = decode0 table x
381 return $
382 case sv of
383 12 ->
384 Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))
385 (FreshPointDecodeInit st)
386 0 -> error "unreachable state"
387 _ -> Skip (FreshPointDecoding st sv cp)
389 -- We recover by trying the new byte x a starter of a new codepoint.
390 -- XXX need to use the same recovery in array decoding routine as well
391 step' table gst (FreshPointDecoding st statePtr codepointPtr) = do
392 r <- step (adaptState gst) st
393 case r of
394 Yield x s -> do
395 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
396 return $
397 case sv of
398 0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)
399 (FreshPointDecodeInit s)
400 12 ->
401 Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)
402 (FreshPointDecodeInit1 s x)
403 _ -> Skip (FreshPointDecoding s sv cp)
404 Skip s -> return $ Skip (FreshPointDecoding s statePtr codepointPtr)
405 Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done
407 step' _ _ (YieldAndContinue c s) = return $ Yield c s
408 step' _ _ Done = return Stop
410{-# INLINE_NORMAL decodeUtf8EitherD #-}
411decodeUtf8EitherD :: Monad m
412 => Stream m Word8 -> Stream m (Either DecodeError Char)
413decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0
415data FlattenState s a
416 = OuterLoop s !(Maybe (DecodeState, CodePoint))
417 | InnerLoopDecodeInit s (ForeignPtr a) !(Ptr a) !(Ptr a)
418 | InnerLoopDecodeFirst s (ForeignPtr a) !(Ptr a) !(Ptr a) Word8
419 | InnerLoopDecoding s (ForeignPtr a) !(Ptr a) !(Ptr a)
420 !DecodeState !CodePoint
421 | YAndC !Char (FlattenState s a) -- These constructors can be
422 -- encoded in the FreshPoint
423 -- type, I prefer to keep these
424 -- flat even though that means
425 -- coming up with new names
426 | D
428-- The normal decodeUtf8 above should fuse with flattenArrays
429-- to create this exact code but it doesn't for some reason, as of now this
430-- remains the fastest way I could figure out to decodeUtf8.
431--
432-- XXX Add Proper error messages
433{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}
434decodeUtf8ArraysWithD ::
435 MonadIO m
436 => CodingFailureMode
437 -> Stream m (A.Array Word8)
438 -> Stream m Char
439decodeUtf8ArraysWithD cfm (Stream step state) =
440 let A.Array p _ _ = utf8d
441 !ptr = (unsafeForeignPtrToPtr p)
442 in Stream (step' ptr) (OuterLoop state Nothing)
443 where
444 {-# INLINE transliterateOrError #-}
445 transliterateOrError e s =
446 case cfm of
447 ErrorOnCodingFailure -> error e
448 TransliterateCodingFailure -> YAndC replacementChar s
449 {-# INLINE inputUnderflow #-}
450 inputUnderflow =
451 case cfm of
452 ErrorOnCodingFailure ->
453 error
454 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Input Underflow"
455 TransliterateCodingFailure -> YAndC replacementChar D
456 {-# INLINE_LATE step' #-}
457 step' _ gst (OuterLoop st Nothing) = do
458 r <- step (adaptState gst) st
459 return $
460 case r of
461 Yield A.Array {..} s ->
462 let p = unsafeForeignPtrToPtr aStart
463 in Skip (InnerLoopDecodeInit s aStart p aEnd)
464 Skip s -> Skip (OuterLoop s Nothing)
465 Stop -> Skip D
466 step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do
467 r <- step (adaptState gst) st
468 return $
469 case r of
470 Yield A.Array {..} s ->
471 let p = unsafeForeignPtrToPtr aStart
472 in Skip (InnerLoopDecoding s aStart p aEnd ds cp)
473 Skip s -> Skip (OuterLoop s dst)
474 Stop -> Skip inputUnderflow
475 step' _ _ (InnerLoopDecodeInit st startf p end)
476 | p == end = do
477 liftIO $ touchForeignPtr startf
478 return $ Skip $ OuterLoop st Nothing
479 step' _ _ (InnerLoopDecodeInit st startf p end) = do
480 x <- liftIO $ peek p
481 -- Note: It is important to use a ">" instead of a "<=" test here for
482 -- GHC to generate code layout for default branch prediction for the
483 -- common case. This is fragile and might change with the compiler
484 -- versions, we need a more reliable "likely" primitive to control
485 -- branch predication.
486 case x > 0x7f of
487 False ->
488 return $ Skip $ YAndC
489 (unsafeChr (fromIntegral x))
490 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
491 -- Using a separate state here generates a jump to a separate code
492 -- block in the core which seems to perform slightly better for the
493 -- non-ascii case.
494 True -> return $ Skip $ InnerLoopDecodeFirst st startf p end x
496 step' table _ (InnerLoopDecodeFirst st startf p end x) = do
497 let (Tuple' sv cp) = decode0 table x
498 return $
499 case sv of
500 12 ->
501 Skip $
502 transliterateOrError
503 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
504 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
505 0 -> error "unreachable state"
506 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
507 step' _ _ (InnerLoopDecoding st startf p end sv cp)
508 | p == end = do
509 liftIO $ touchForeignPtr startf
510 return $ Skip $ OuterLoop st (Just (sv, cp))
511 step' table _ (InnerLoopDecoding st startf p end statePtr codepointPtr) = do
512 x <- liftIO $ peek p
513 let (Tuple' sv cp) = decode1 table statePtr codepointPtr x
514 return $
515 case sv of
516 0 ->
517 Skip $
518 YAndC
519 (unsafeChr cp)
520 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
521 12 ->
522 Skip $
523 transliterateOrError
524 "Streamly.Internal.Data.Stream.StreamD.decodeUtf8ArraysWith: Invalid UTF8 codepoint encountered"
525 (InnerLoopDecodeInit st startf (p `plusPtr` 1) end)
526 _ -> Skip (InnerLoopDecoding st startf (p `plusPtr` 1) end sv cp)
527 step' _ _ (YAndC c s) = return $ Yield c s
528 step' _ _ D = return Stop
530{-# INLINE decodeUtf8ArraysD #-}
531decodeUtf8ArraysD ::
532 MonadIO m
533 => Stream m (A.Array Word8)
534 -> Stream m Char
535decodeUtf8ArraysD = decodeUtf8ArraysWithD ErrorOnCodingFailure
537{-# INLINE decodeUtf8ArraysLenientD #-}
538decodeUtf8ArraysLenientD ::
539 MonadIO m
540 => Stream m (A.Array Word8)
541 -> Stream m Char
542decodeUtf8ArraysLenientD = decodeUtf8ArraysWithD TransliterateCodingFailure
544data EncodeState s = EncodeState s !WList
546-- More yield points improve performance, but I am not sure if they can cause
547-- too much code bloat or some trouble with fusion. So keeping only two yield
548-- points for now, one for the ascii chars (fast path) and one for all other
549-- paths (slow path).
550{-# INLINE_NORMAL encodeUtf8D #-}
551encodeUtf8D :: Monad m => Stream m Char -> Stream m Word8
552encodeUtf8D (Stream step state) = Stream step' (EncodeState state WNil)
553 where
554 {-# INLINE_LATE step' #-}
555 step' gst (EncodeState st WNil) = do
556 r <- step (adaptState gst) st
557 return $
558 case r of
559 Yield c s ->
560 case ord c of
561 x
562 | x <= 0x7F ->
563 Yield (fromIntegral x) (EncodeState s WNil)
564 | x <= 0x7FF -> Skip (EncodeState s (ord2 c))
565 | x <= 0xFFFF ->
566 if isSurrogate c
567 then error
568 "Streamly.Internal.Data.Stream.StreamD.encodeUtf8: Encountered a surrogate"
569 else Skip (EncodeState s (ord3 c))
570 | otherwise -> Skip (EncodeState s (ord4 c))
571 Skip s -> Skip (EncodeState s WNil)
572 Stop -> Stop
573 step' _ (EncodeState s (WCons x xs)) = return $ Yield x (EncodeState s xs)
576-- | Decode a stream of bytes to Unicode characters by mapping each byte to a
577-- corresponding Unicode 'Char' in 0-255 range.
578--
579-- /Since: 0.7.0/
580{-# INLINE decodeLatin1 #-}
581decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char
582decodeLatin1 = S.map (unsafeChr . fromIntegral)
584-- | Encode a stream of Unicode characters to bytes by mapping each character
585-- to a byte in 0-255 range. Throws an error if the input stream contains
586-- characters beyond 255.
587--
588-- /Since: 0.7.0/
589{-# INLINE encodeLatin1 #-}
590encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8
591encodeLatin1 = S.map convert
592 where
593 convert c =
594 let codepoint = ord c
595 in if codepoint > 255
596 then error $ "Streamly.String.encodeLatin1 invalid " ++
597 "input char codepoint " ++ show codepoint
598 else fromIntegral codepoint
600-- | Like 'encodeLatin1' but silently truncates and maps input characters beyond
601-- 255 to (incorrect) chars in 0-255 range. No error or exception is thrown
602-- when such truncation occurs.
603--
604-- /Since: 0.7.0/
605{-# INLINE encodeLatin1Lax #-}
606encodeLatin1Lax :: (IsStream t, Monad m) => t m Char -> t m Word8
607encodeLatin1Lax = S.map (fromIntegral . ord)
609-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
610-- The incoming stream is truncated if an invalid codepoint is encountered.
611--
612-- /Since: 0.7.0/
613{-# INLINE decodeUtf8 #-}
614decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char
615decodeUtf8 = D.fromStreamD . decodeUtf8D . D.toStreamD
617-- |
618--
619-- /Internal/
620{-# INLINE decodeUtf8Arrays #-}
621decodeUtf8Arrays :: (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
622decodeUtf8Arrays = D.fromStreamD . decodeUtf8ArraysD . D.toStreamD
624-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.
625-- Any invalid codepoint encountered is replaced with the unicode replacement
626-- character.
627--
628-- /Since: 0.7.0/
629{-# INLINE decodeUtf8Lax #-}
630decodeUtf8Lax :: (Monad m, IsStream t) => t m Word8 -> t m Char
631decodeUtf8Lax = D.fromStreamD . decodeUtf8LenientD . D.toStreamD
633-- |
634--
635-- /Internal/
636{-# INLINE decodeUtf8Either #-}
637decodeUtf8Either :: (Monad m, IsStream t)
638 => t m Word8 -> t m (Either DecodeError Char)
639decodeUtf8Either = D.fromStreamD . decodeUtf8EitherD . D.toStreamD
641-- |
642--
643-- /Internal/
644{-# INLINE resumeDecodeUtf8Either #-}
645resumeDecodeUtf8Either
646 :: (Monad m, IsStream t)
647 => DecodeState
648 -> CodePoint
649 -> t m Word8
650 -> t m (Either DecodeError Char)
651resumeDecodeUtf8Either st cp =
652 D.fromStreamD . resumeDecodeUtf8EitherD st cp . D.toStreamD
654-- |
655--
656-- /Internal/
657{-# INLINE decodeUtf8ArraysLenient #-}
658decodeUtf8ArraysLenient ::
659 (MonadIO m, IsStream t) => t m (Array Word8) -> t m Char
660decodeUtf8ArraysLenient =
661 D.fromStreamD . decodeUtf8ArraysLenientD . D.toStreamD
663-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.
664--
665-- /Since: 0.7.0/
666{-# INLINE encodeUtf8 #-}
667encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8
668encodeUtf8 = D.fromStreamD . encodeUtf8D . D.toStreamD
670{-
671-------------------------------------------------------------------------------
672-- Utility operations on strings
673-------------------------------------------------------------------------------
675strip :: IsStream t => t m Char -> t m Char
676strip = undefined
678stripEnd :: IsStream t => t m Char -> t m Char
679stripEnd = undefined
680-}
682-- | Remove leading whitespace from a string.
683--
684-- > stripStart = S.dropWhile isSpace
685--
686-- /Internal/
687{-# INLINE stripStart #-}
688stripStart :: (Monad m, IsStream t) => t m Char -> t m Char
689stripStart = S.dropWhile isSpace
691-- | Fold each line of the stream using the supplied 'Fold'
692-- and stream the result.
693--
694-- >>> S.toList $ lines FL.toList (S.fromList "lines\nthis\nstring\n\n\n")
695-- ["lines", "this", "string", "", ""]
696--
697-- > lines = S.splitOnSuffix (== '\n')
698--
699-- /Internal/
700{-# INLINE lines #-}
701lines :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
702lines = S.splitOnSuffix (== '\n')
704foreign import ccall unsafe "u_iswspace"
705 iswspace :: Int -> Int
707-- | Code copied from base/Data.Char to INLINE it
708{-# INLINE isSpace #-}
709isSpace :: Char -> Bool
710isSpace c
711 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
712 | otherwise = iswspace (ord c) /= 0
713 where
714 uc = fromIntegral (ord c) :: Word
716-- | Fold each word of the stream using the supplied 'Fold'
717-- and stream the result.
718--
719-- >>> S.toList $ words FL.toList (S.fromList "fold these words")
720-- ["fold", "these", "words"]
721--
722-- > words = S.wordsBy isSpace
723--
724-- /Internal/
725{-# INLINE words #-}
726words :: (Monad m, IsStream t) => Fold m Char b -> t m Char -> t m b
727words = S.wordsBy isSpace
729-- | Unfold a stream to character streams using the supplied 'Unfold'
730-- and concat the results suffixing a newline character @\\n@ to each stream.
731--
732-- /Internal/
733{-# INLINE unlines #-}
734unlines :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
735unlines = S.interposeSuffix '\n'
737-- | Unfold the elements of a stream to character streams using the supplied
738-- 'Unfold' and concat the results with a whitespace character infixed between
739-- the streams.
740--
741-- /Internal/
742{-# INLINE unwords #-}
743unwords :: (MonadIO m, IsStream t) => Unfold m a Char -> t m a -> t m Char
744unwords = S.interpose ' '