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