005b4b7 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Merge pull request #204 from composewell/string

005b4b7Harendra Kumar7 years ago

Changelog.md+2

compare with master

unifiedsplit

@@ -66,6 +66,8 @@ example, concat streams concurrently using this.

66 * `reverse'` a several times faster reverse using Storable instance

67 * `intersperseByTime` intersperse a mondadic action in a stream

68 periodically

69+ * `intersperse` intersperse an element in between consecutive elements in

70+ stream

70### Deprecations

72### Deprecations

benchmark/BaseStreams.hs+6

@@ -101,6 +101,8 @@ main =

101 , benchIO "mapMaybeM" (D.mapMaybeM 1) D.sourceUnfoldrM

102 , benchIO "concatMap" (D.concatMap 1) (D.sourceUnfoldrMN D.value2)

103 , benchIO "concatMapPure" (D.concatMap 1) (D.sourceUnfoldrN D.value2)

104+ , benchIO "intersperse" (D.intersperse 1) (D.sourceUnfoldrMN D.value2)

105+ , benchIO "interspersePure" (D.intersperse 1) (D.sourceUnfoldrN D.value2)

104 -- , benchIO "foldrS" (D.foldrS 1) D.sourceUnfoldrM

106 -- , benchIO "foldrS" (D.foldrS 1) D.sourceUnfoldrM

105 -- This has horrible performance, never finishes

107 -- This has horrible performance, never finishes

106 -- , benchIO "foldlS" (D.foldlS 1) D.sourceUnfoldrM

108 -- , benchIO "foldlS" (D.foldlS 1) D.sourceUnfoldrM

@@ -113,6 +115,7 @@ main =

113 , benchIO "mapMaybe" (D.mapMaybe 4) D.sourceUnfoldrM

115 , benchIO "mapMaybe" (D.mapMaybe 4) D.sourceUnfoldrM

114 , benchIO "mapMaybeM" (D.mapMaybeM 4) D.sourceUnfoldrM

116 , benchIO "mapMaybeM" (D.mapMaybeM 4) D.sourceUnfoldrM

115 -- , benchIO "concatMap" (D.concatMap 4) (D.sourceUnfoldrMN D.value16)

117 -- , benchIO "concatMap" (D.concatMap 4) (D.sourceUnfoldrMN D.value16)

118+ , benchIO "intersperse" (D.intersperse 4) (D.sourceUnfoldrMN D.value16)

116 ]

119 ]

117 , bgroup "filtering"

120 , bgroup "filtering"

118 [ benchIO "filter-even" (D.filterEven 1) D.sourceUnfoldrM

121 [ benchIO "filter-even" (D.filterEven 1) D.sourceUnfoldrM

@@ -242,6 +245,8 @@ main =

242 -- , benchIOSrcK "concatMap" K.concatMap

245 -- , benchIOSrcK "concatMap" K.concatMap

243 , benchIO "concatMap" (K.concatMap 1) (K.sourceUnfoldrMN K.value2)

246 , benchIO "concatMap" (K.concatMap 1) (K.sourceUnfoldrMN K.value2)

244 , benchIO "concatMapPure" (K.concatMap 1) (K.sourceUnfoldrN K.value2)

247 , benchIO "concatMapPure" (K.concatMap 1) (K.sourceUnfoldrN K.value2)

248+ , benchIO "intersperse" (K.intersperse 1) (K.sourceUnfoldrMN K.value2)

249+ , benchIO "interspersePure" (K.intersperse 1) (K.sourceUnfoldrN K.value2)

245 , benchIO "foldlS" (K.foldlS 1) K.sourceUnfoldrM

250 , benchIO "foldlS" (K.foldlS 1) K.sourceUnfoldrM

246 ]

251 ]

247 , bgroup "transformationX4"

252 , bgroup "transformationX4"

@@ -251,6 +256,7 @@ main =

251 , benchIO "mapM" (K.mapM 4) K.sourceUnfoldrM

256 , benchIO "mapM" (K.mapM 4) K.sourceUnfoldrM

252 , benchIO "mapMSerial" (K.mapMSerial 4) K.sourceUnfoldrM

257 , benchIO "mapMSerial" (K.mapMSerial 4) K.sourceUnfoldrM

253 -- , benchIO "concatMap" (K.concatMap 4) (K.sourceUnfoldrMN K.value16)

258 -- , benchIO "concatMap" (K.concatMap 4) (K.sourceUnfoldrMN K.value16)

259+ , benchIO "intersperse" (K.intersperse 4) (K.sourceUnfoldrMN K.value16)

254 ]

260 ]

255 , bgroup "filtering"

261 , bgroup "filtering"

256 [ benchIO "filter-even" (K.filterEven 1) K.sourceUnfoldrM

262 [ benchIO "filter-even" (K.filterEven 1) K.sourceUnfoldrM

benchmark/FileIO.hs+34

@@ -18,6 +18,7 @@ import Gauge

18import qualified Streamly.FileSystem.Handle as FH

19import qualified Streamly.Mem.Array as A

20import qualified Streamly.Prelude as S

21+import qualified Streamly.String as SS

22#ifdef DEVBUILD

23#ifdef DEVBUILD

23import Data.Char (ord, chr)

24import Data.Char (ord, chr)

@@ -133,6 +134,21 @@ main = do

133 Handles inh outh <- readIORef href

134 Handles inh outh <- readIORef href

134 FH.write outh (FH.read inh)

135 FH.write outh (FH.read inh)

135 ]

136 ]

137+ -- This needs an ascii file, as decode just errors out.

138+ , bgroup "decode/encode"

139+ [ mkBench "encodeChar8/decodeChar8" href $ do

140+ Handles inh outh <- readIORef href

141+ FH.write outh

142+ $ SS.encodeChar8

143+ $ SS.decodeChar8

144+ $ FH.read inh

145+ , mkBench "encodeUtf8/decodeUtf8" href $ do

146+ Handles inh outh <- readIORef href

147+ FH.write outh

148+ $ SS.encodeUtf8

149+ $ SS.decodeUtf8

150+ $ FH.read inh

151+ ]

136 , bgroup "grouping"

152 , bgroup "grouping"

137 [ mkBench "chunksOf 1 (toArray)" href $ do

153 [ mkBench "chunksOf 1 (toArray)" href $ do

138 Handles inh _ <- readIORef href

154 Handles inh _ <- readIORef href

@@ -149,6 +165,24 @@ main = do

149 Handles inh _ <- readIORef href

165 Handles inh _ <- readIORef href

150 S.length $ FL.chunksOf 1000 FL.drain (FH.read inh)

166 S.length $ FL.chunksOf 1000 FL.drain (FH.read inh)

151 ]

167 ]

168+ , bgroup "group/ungroup"

169+ [ mkBench "lines/unlines" href $ do

170+ Handles inh outh <- readIORef href

171+ FH.write outh

172+ $ SS.encodeChar8

173+ $ SS.unlines

174+ $ SS.lines

175+ $ SS.decodeChar8

176+ $ FH.read inh

177+ , mkBench "words/unwords" href $ do

178+ Handles inh outh <- readIORef href

179+ FH.write outh

180+ $ SS.encodeChar8

181+ $ SS.unwords

182+ $ SS.words

183+ $ SS.decodeChar8

184+ $ FH.read inh

185+ ]

152

186

153 , let lf = fromIntegral (ord '\n')

187 , let lf = fromIntegral (ord '\n')

154 lfarr = A.fromList [lf]

188 lfarr = A.fromList [lf]

benchmark/Linear.hs+2

@@ -300,6 +300,7 @@ main =

300 --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 1)

301 , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 1)

302 , benchIOSink "deleteBy" (Ops.deleteBy 1)

303+ , benchIOSink "intersperse" (Ops.intersperse 1)

303 , benchIOSink "insertBy" (Ops.insertBy 1)

304 , benchIOSink "insertBy" (Ops.insertBy 1)

304 ]

305 ]

305 , bgroup "filteringX4"

306 , bgroup "filteringX4"

@@ -315,6 +316,7 @@ main =

315 --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 4)

316 --, benchIOSink "dropWhileM-true" (Ops.dropWhileMTrue 4)

316 , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 4)

317 , benchIOSink "dropWhile-false" (Ops.dropWhileFalse 4)

317 , benchIOSink "deleteBy" (Ops.deleteBy 4)

318 , benchIOSink "deleteBy" (Ops.deleteBy 4)

319+ , benchIOSink "intersperse" (Ops.intersperse 4)

318 , benchIOSink "insertBy" (Ops.insertBy 4)

320 , benchIOSink "insertBy" (Ops.insertBy 4)

319 ]

321 ]

320 , bgroup "multi-stream"

322 , bgroup "multi-stream"

benchmark/LinearOps.hs+3−1

@@ -357,7 +357,8 @@ scan, scanl1', map, fmap, mapMaybe, filterEven, filterAllOut,

357 => Int -> Stream m Int -> m ()

358

359{-# INLINE mapMaybeM #-}

360+{-# INLINE intersperse #-}

360−mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()

361+mapMaybeM, intersperse :: S.MonadAsync m => Int -> Stream m Int -> m ()

361

362

362{-# INLINE mapM #-}

363{-# INLINE mapM #-}

363{-# INLINE transformMapM #-}

364{-# INLINE transformMapM #-}

@@ -415,6 +416,7 @@ dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))

415dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)

416dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)

416findIndices n = composeN n $ S.findIndices (== maxValue)

417findIndices n = composeN n $ S.findIndices (== maxValue)

417elemIndices n = composeN n $ S.elemIndices maxValue

418elemIndices n = composeN n $ S.elemIndices maxValue

419+intersperse n = composeN n $ S.intersperse maxValue

418insertBy n = composeN n $ S.insertBy compare maxValue

420insertBy n = composeN n $ S.insertBy compare maxValue

419deleteBy n = composeN n $ S.deleteBy (>=) maxValue

421deleteBy n = composeN n $ S.deleteBy (>=) maxValue

420reverse n = composeN n $ S.reverse

422reverse n = composeN n $ S.reverse

benchmark/StreamDOps.hs+3−1

@@ -177,10 +177,11 @@ composeN n f =

177{-# INLINE foldrS #-}

178{-# INLINE foldlS #-}

179{-# INLINE concatMap #-}

180+{-# INLINE intersperse #-}

180scan, map, fmap, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,

181scan, map, fmap, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,

181 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

182 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

182 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse, foldrS, foldlS,

183 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse, foldrS, foldlS,

183− concatMap

184+ concatMap, intersperse

184 :: Monad m

185 :: Monad m

185 => Int -> Stream m Int -> m ()

186 => Int -> Stream m Int -> m ()

186

187

@@ -207,6 +208,7 @@ dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)

207foldrS n = composeN n $ S.foldrS S.cons S.nil

208foldrS n = composeN n $ S.foldrS S.cons S.nil

208foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil

209foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil

209concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)

210concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)

211+intersperse n = composeN n $ S.intersperse maxValue

210

212

211-------------------------------------------------------------------------------

213-------------------------------------------------------------------------------

212-- Iteration

214-- Iteration

benchmark/StreamKOps.hs+4−1

@@ -205,7 +205,9 @@ scan, map, fmap, filterEven, filterAllOut,

205

206{-# INLINE mapM #-}

207{-# INLINE mapMSerial #-}

208+{-# INLINE intersperse #-}

209+mapM, mapMSerial, intersperse

208−mapM, mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()

210+ :: S.MonadAsync m => Int -> Stream m Int -> m ()

209

211

210scan n = composeN n $ S.scanl' (+) 0

212scan n = composeN n $ S.scanl' (+) 0

211map n = composeN n $ P.fmap (+1)

213map n = composeN n $ P.fmap (+1)

@@ -224,6 +226,7 @@ dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)

224dropWhileFalse n = composeN n $ S.dropWhile (<= 1)

226dropWhileFalse n = composeN n $ S.dropWhile (<= 1)

225foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil

227foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil

226concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)

228concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)

229+intersperse n = composeN n $ S.intersperse maxValue

227

230

228-------------------------------------------------------------------------------

231-------------------------------------------------------------------------------

229-- Iteration

232-- Iteration

examples/HandleIO.hs+3−1

@@ -2,6 +2,7 @@ import qualified Streamly.Prelude as S

2import qualified Streamly.Fold as FL

3import qualified Streamly.Mem.Array as A

4import qualified Streamly.FileSystem.Handle as FH

5+import qualified Streamly.String as SS

6import Data.Char (ord)

7import Data.Char (ord)

7import System.Environment (getArgs)

8import System.Environment (getArgs)

@@ -18,7 +19,8 @@ ord' = (fromIntegral . ord)

19wcl :: Handle -> IO ()

20wcl :: Handle -> IO ()

20wcl src = print =<< (S.length

21wcl src = print =<< (S.length

21− $ FL.splitSuffixBy (== ord' '\n') FL.drain

22+ $ flip SS.foldLines FL.drain

23+ $ SS.decodeChar8

22 $ FH.read src)

24 $ FH.read src)

24grepc :: String -> Handle -> IO ()

26grepc :: String -> Handle -> IO ()

src/Streamly/FileSystem/Handle.hs+16−3

@@ -114,6 +114,7 @@ import Streamly.Streams.StreamK.Type (IsStream, mkStream)

114import qualified Streamly.Mem.Array as A

115import qualified Streamly.Mem.Array.Types as A hiding (flattenArrays)

116import qualified Streamly.Prelude as S

117+import qualified Streamly.Streams.StreamD.Type as D

117

118

118-------------------------------------------------------------------------------

119-------------------------------------------------------------------------------

119-- References

120-- References

@@ -174,10 +175,10 @@ writeArray h Array{..} = withForeignPtr aStart $ \p -> hPutBuf h p aLen

174-- | @readArraysUpto size h@ reads a stream of arrays from file handle @h@.

175-- | @readArraysUpto size h@ reads a stream of arrays from file handle @h@.

175-- The maximum size of a single array is specified by @size@. The actual size

176-- The maximum size of a single array is specified by @size@. The actual size

176-- read may be less than or equal to @size@.

177-- read may be less than or equal to @size@.

177−{-# INLINABLE readArraysUpto #-}

178+{-# INLINABLE _readArraysUpto #-}

178−readArraysUpto :: (IsStream t, MonadIO m)

179+_readArraysUpto :: (IsStream t, MonadIO m)

179 => Int -> Handle -> t m (Array Word8)

180 => Int -> Handle -> t m (Array Word8)

180−readArraysUpto size h = go

181+_readArraysUpto size h = go

181 where

182 where

182 -- XXX use cons/nil instead

183 -- XXX use cons/nil instead

183 go = mkStream $ \_ yld _ stp -> do

184 go = mkStream $ \_ yld _ stp -> do

@@ -186,6 +187,18 @@ readArraysUpto size h = go

186 then stp

187 then stp

187 else yld arr go

188 else yld arr go

188

189

190+{-# INLINE_NORMAL readArraysUpto #-}

191+readArraysUpto :: (IsStream t, MonadIO m) => Int -> Handle -> t m (Array Word8)

192+readArraysUpto size h = D.fromStreamD (D.Stream step ())

193+ where

194+ {-# INLINE_LATE step #-}

195+ step _ _ = do

196+ arr <- liftIO $ readArrayUpto size h

197+ return $

198+ case A.length arr of

199+ 0 -> D.Stop

200+ _ -> D.Yield arr ()

201+

189-- XXX read 'Array a' instead of Word8

202-- XXX read 'Array a' instead of Word8

190--

203--

191-- | @readArrays h@ reads a stream of arrays from file handle @h@.

204-- | @readArrays h@ reads a stream of arrays from file handle @h@.

src/Streamly/Mem/Array/Types.hs+93−6

@@ -6,7 +6,7 @@

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE UnboxedTuples #-}

9−

9+{-# LANGUAGE FlexibleContexts #-}

10#include "inline.hs"

12-- |

@@ -26,7 +26,8 @@ module Streamly.Mem.Array.Types

26 , unsafeInlineIO

27 , withNewArray

28 , newArray

29− , unsafeAppend

29+ , unsafeSnoc

30+ , snoc

30 , shrinkToFit

31 , shrinkToFit

31 , memcpy

32 , memcpy

32 , memcmp

33 , memcmp

@@ -48,6 +49,8 @@ module Streamly.Mem.Array.Types

49 , toStreamD

50 , toStreamD

50 , toStreamDRev

51 , toStreamDRev

52+ , toStreamK

53+ , toStreamKRev

51 , toList

54 , toList

52 , toArrayN

55 , toArrayN

53 , read

56 , read

@@ -57,6 +60,8 @@ module Streamly.Mem.Array.Types

57 , mkChunkSize

60 , mkChunkSize

58 , mkChunkSizeKB

61 , mkChunkSizeKB

59 , reallocDouble

62 , reallocDouble

63+

64+ , unlines

60 )

65 )

61where

66where

@@ -73,7 +78,7 @@ import Foreign.ForeignPtr

73import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

78import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

74import Foreign.Ptr (plusPtr, minusPtr, castPtr)

79import Foreign.Ptr (plusPtr, minusPtr, castPtr)

75import Foreign.Storable (Storable(..))

80import Foreign.Storable (Storable(..))

76−import Prelude hiding (length, foldr, read)

81+import Prelude hiding (length, foldr, read, unlines, unwords)

77import Text.Read (readPrec, readListPrec, readListPrecDefault)

82import Text.Read (readPrec, readListPrec, readListPrecDefault)

79import GHC.Base (Addr#, realWorld#)

84import GHC.Base (Addr#, realWorld#)

@@ -213,15 +218,39 @@ withNewArray count f = do

213-- Internal routine for when the array is being created. Appends one item at

218-- Internal routine for when the array is being created. Appends one item at

214-- the end of the array. Useful when sequentially writing a stream to the

219-- the end of the array. Useful when sequentially writing a stream to the

215-- array. DOES NOT CHECK THE ARRAY BOUNDS.

220-- array. DOES NOT CHECK THE ARRAY BOUNDS.

216−{-# INLINE unsafeAppend #-}

221+{-# INLINE unsafeSnoc #-}

217−unsafeAppend :: forall a. Storable a => Array a -> a -> IO (Array a)

222+unsafeSnoc :: forall a. Storable a => Array a -> a -> IO (Array a)

218−unsafeAppend arr@Array{..} x = do

223+unsafeSnoc arr@Array{..} x = do

219 when (aEnd == aBound) $

224 when (aEnd == aBound) $

220 error "BUG: unsafeAppend: writing beyond array bounds"

225 error "BUG: unsafeAppend: writing beyond array bounds"

221 poke aEnd x

226 poke aEnd x

222 touchForeignPtr aStart

227 touchForeignPtr aStart

223 return $ arr {aEnd = aEnd `plusPtr` (sizeOf (undefined :: a))}

228 return $ arr {aEnd = aEnd `plusPtr` (sizeOf (undefined :: a))}

224

229

230+{-# INLINE snoc #-}

231+snoc :: forall a. Storable a => Array a -> a -> Array a

232+snoc arr@Array {..} x = unsafePerformIO $

233+ if (aEnd == aBound)

234+ then do

235+ let oldStart = unsafeForeignPtrToPtr aStart

236+ size = aEnd `minusPtr` oldStart

237+ newSize = (size + (sizeOf (undefined :: a)))

238+ newPtr <- mallocPlainForeignPtrAlignedBytes newSize (alignment (undefined :: a))

239+ withForeignPtr newPtr $ \pNew -> do

240+ memcpy (castPtr pNew) (castPtr oldStart) size

241+ poke (pNew `plusPtr` size) x

242+ touchForeignPtr aStart

243+ return $ Array

244+ { aStart = newPtr

245+ , aEnd = pNew `plusPtr` (size + sizeOf (undefined :: a))

246+ , aBound = pNew `plusPtr` newSize

247+ }

248+ else do

249+ poke aEnd x

250+ touchForeignPtr aStart

251+ return $ arr {aEnd = aEnd `plusPtr` (sizeOf (undefined :: a))}

252+

253+

225-- | Remove the free space from an Array.

254-- | Remove the free space from an Array.

226shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)

255shrinkToFit :: forall a. Storable a => Array a -> IO (Array a)

227shrinkToFit arr@Array{..} = do

256shrinkToFit arr@Array{..} = do

@@ -344,6 +373,23 @@ toStreamD Array{..} =

344 return r

373 return r

345 return $ D.Yield x (p `plusPtr` (sizeOf (undefined :: a)))

374 return $ D.Yield x (p `plusPtr` (sizeOf (undefined :: a)))

346

375

376+{-# INLINE toStreamK #-}

377+toStreamK :: forall t m a. (K.IsStream t, Storable a) => Array a -> t m a

378+toStreamK Array{..} =

379+ let p = unsafeForeignPtrToPtr aStart

380+ in go p

381+

382+ where

383+

384+ go p | p == aEnd = K.nil

385+ | otherwise =

386+ -- See Note in toStreamD.

387+ let !x = unsafeInlineIO $ do

388+ r <- peek p

389+ touchForeignPtr aStart

390+ return r

391+ in x `K.cons` go (p `plusPtr` (sizeOf (undefined :: a)))

392+

347{-# INLINE_NORMAL toStreamDRev #-}

393{-# INLINE_NORMAL toStreamDRev #-}

348toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

394toStreamDRev :: forall m a. (Monad m, Storable a) => Array a -> D.Stream m a

349toStreamDRev Array{..} =

395toStreamDRev Array{..} =

@@ -362,6 +408,22 @@ toStreamDRev Array{..} =

362 return r

408 return r

363 return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

409 return $ D.Yield x (p `plusPtr` negate (sizeOf (undefined :: a)))

364

410

411+{-# INLINE toStreamKRev #-}

412+toStreamKRev :: forall t m a. (K.IsStream t, Storable a) => Array a -> t m a

413+toStreamKRev Array {..} =

414+ let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

415+ in go p

416+

417+ where

418+

419+ go p | p < unsafeForeignPtrToPtr aStart = K.nil

420+ | otherwise =

421+ let !x = unsafeInlineIO $ do

422+ r <- peek p

423+ touchForeignPtr aStart

424+ return r

425+ in x `K.cons` go (p `plusPtr` negate (sizeOf (undefined :: a)))

426+

365{-# INLINE_NORMAL foldl' #-}

427{-# INLINE_NORMAL foldl' #-}

366foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b

428foldl' :: forall a b. Storable a => (b -> a -> b) -> b -> Array a -> b

367foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

429foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr

@@ -665,3 +727,28 @@ mkChunkSizeKB n = mkChunkSize (n * k)

665-- bytes, so that the actual allocation is 32KB.

727-- bytes, so that the actual allocation is 32KB.

666defaultChunkSize :: Int

728defaultChunkSize :: Int

667defaultChunkSize = mkChunkSizeKB 32

729defaultChunkSize = mkChunkSizeKB 32

730+

731+{-# INLINE_NORMAL unlines #-}

732+unlines :: MonadIO m => D.Stream m (Array Char) -> D.Stream m Char

733+unlines (D.Stream step state) = D.Stream step' (OuterLoop state)

734+ where

735+ {-# INLINE_LATE step' #-}

736+ step' gst (OuterLoop st) = do

737+ r <- step (adaptState gst) st

738+ return $ case r of

739+ D.Yield Array{..} s ->

740+ let p = unsafeForeignPtrToPtr aStart

741+ in D.Skip (InnerLoop s aStart p aEnd)

742+ D.Skip s -> D.Skip (OuterLoop s)

743+ D.Stop -> D.Stop

744+

745+ step' _ (InnerLoop st _ p end) | p == end =

746+ return $ D.Yield '\n' $ OuterLoop st

747+

748+ step' _ (InnerLoop st startf p end) = do

749+ x <- liftIO $ do

750+ r <- peek p

751+ touchForeignPtr startf

752+ return r

753+ return $ D.Yield x (InnerLoop st startf

754+ (p `plusPtr` (sizeOf (undefined :: Char))) end)

src/Streamly/Prelude.hs+15−1

@@ -369,6 +369,7 @@ module Streamly.Prelude

369

370 , insertBy

371 , intersperseM

372+ , intersperse

372 -- , intersperseBySpan

373 -- , intersperseBySpan

373 , intersperseByTime

374 , intersperseByTime

374

375

@@ -1933,7 +1934,20 @@ reverse' s = fromStreamD $ D.reverse' $ toStreamD s

1933-- @since 0.5.0

1934-- @since 0.5.0

1934{-# INLINE intersperseM #-}

1935{-# INLINE intersperseM #-}

1935intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

1936intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

1936−intersperseM = K.intersperseM

1937+intersperseM m = fromStreamS . S.intersperseM m . toStreamS

1938+

1939+-- | Generate a stream by inserting a given element between consecutive

1940+-- elements of the given stream.

1941+--

1942+-- @

1943+-- > S.toList $ S.intersperse ',' $ S.fromList "hello"

1944+-- "h,e,l,l,o"

1945+-- @

1946+--

1947+-- @since 0.7.0

1948+{-# INLINE intersperse #-}

1949+intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a

1950+intersperse a = fromStreamS . S.intersperse a . toStreamS

1937

1951

1938{-

1952{-

1939-- | Intersperse a monadic action into the input stream after every @n@

1953-- | Intersperse a monadic action into the input stream after every @n@

src/Streamly/Streams/StreamD.hs+282−1

@@ -10,6 +10,7 @@

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ViewPatterns #-}

12{-# LANGUAGE RankNTypes #-}

13+{-# LANGUAGE MagicHash #-}

14#include "inline.hs"

15#include "inline.hs"

@@ -202,6 +203,8 @@ module Streamly.Streams.StreamD

202 , sequence

203 , sequence

203

204

204 -- * Inserting

205 -- * Inserting

206+ , intersperseM

207+ , intersperse

205 , insertBy

208 , insertBy

206

209

207 -- * Deleting

210 -- * Deleting

@@ -235,6 +238,10 @@ module Streamly.Streams.StreamD

235 , onException

238 , onException

236 , finally

239 , finally

237 , handle

240 , handle

241+

242+ -- * UTF8 Encoding / Decoding transformations.

243+ , decodeUtf8

244+ , encodeUtf8

238 )

245 )

239where

246where

240

247

@@ -242,12 +249,16 @@ import Control.Exception (Exception)

242import Control.Monad.Catch (MonadCatch)

249import Control.Monad.Catch (MonadCatch)

243import Control.Monad.IO.Class (MonadIO(..))

250import Control.Monad.IO.Class (MonadIO(..))

244import Control.Monad.Trans (MonadTrans(lift))

251import Control.Monad.Trans (MonadTrans(lift))

245−import Data.Word (Word32)

246import Data.Bits (shiftR, shiftL, (.|.), (.&.))

252import Data.Bits (shiftR, shiftL, (.|.), (.&.))

247import Data.Maybe (fromJust, isJust)

253import Data.Maybe (fromJust, isJust)

254+import Data.Word (Word32)

248import Foreign.Ptr (Ptr)

255import Foreign.Ptr (Ptr)

249import Foreign.Storable (Storable(..))

256import Foreign.Storable (Storable(..))

257+import GHC.Base (assert, Char(..), unsafeChr, (-#), (+#), uncheckedIShiftL#,

258+ word2Int#, chr#, ord)

259+import GHC.IO.Encoding.Failure (isSurrogate)

250import GHC.Types (SPEC(..))

260import GHC.Types (SPEC(..))

261+import GHC.Word (Word8(..))

251import Prelude

262import Prelude

252 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

263 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

253 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

264 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

@@ -2165,6 +2176,38 @@ sequence (Stream step state) = Stream step' state

2165-- Inserting

2176-- Inserting

2166------------------------------------------------------------------------------

2177------------------------------------------------------------------------------

2167

2178

2179+data LoopState x s = FirstYield s

2180+ | InterspersingYield s

2181+ | YieldAndCarry x s

2182+

2183+{-# INLINE_NORMAL intersperseM #-}

2184+intersperseM :: Monad m => m a -> Stream m a -> Stream m a

2185+intersperseM m (Stream step state) = Stream step' (FirstYield state)

2186+ where

2187+ {-# INLINE_LATE step' #-}

2188+ step' gst (FirstYield st) = do

2189+ r <- step gst st

2190+ return $

2191+ case r of

2192+ Yield x s -> Skip (YieldAndCarry x s)

2193+ Skip s -> Skip (FirstYield s)

2194+ Stop -> Stop

2195+

2196+ step' gst (InterspersingYield st) = do

2197+ r <- step gst st

2198+ case r of

2199+ Yield x s -> do

2200+ a <- m

2201+ return $ Yield a (YieldAndCarry x s)

2202+ Skip s -> return $ Skip $ InterspersingYield s

2203+ Stop -> return Stop

2204+

2205+ step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)

2206+

2207+{-# INLINE intersperse #-}

2208+intersperse :: Monad m => a -> Stream m a -> Stream m a

2209+intersperse a = intersperseM (return a)

2210+

2168{-# INLINE_NORMAL insertBy #-}

2211{-# INLINE_NORMAL insertBy #-}

2169insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a

2212insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a

2170insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)

2213insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)

@@ -2355,3 +2398,241 @@ the (Stream step state) = go state

2355 | otherwise -> return Nothing

2398 | otherwise -> return Nothing

2356 Skip s -> go' n s

2399 Skip s -> go' n s

2357 Stop -> return (Just n)

2400 Stop -> return (Just n)

2401+

2402+--------------------------------------------------------------------------------

2403+-- UTF8 Encoding / Decoding

2404+--------------------------------------------------------------------------------

2405+

2406+-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.

2407+

2408+ord2 :: Char -> [Word8]

2409+ord2 c = assert (n >= 0x80 && n <= 0x07ff) [x1, x2]

2410+ where

2411+ n = ord c

2412+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

2413+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80

2414+

2415+ord3 :: Char -> [Word8]

2416+ord3 c = assert (n >= 0x0800 && n <= 0xffff) [x1, x2, x3]

2417+ where

2418+ n = ord c

2419+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0

2420+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

2421+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80

2422+

2423+ord4 :: Char -> [Word8]

2424+ord4 c = assert (n >= 0x10000) [x1, x2, x3, x4]

2425+ where

2426+ n = ord c

2427+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0

2428+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80

2429+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

2430+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80

2431+

2432+{-# INLINE chr2 #-}

2433+chr2 :: Word8 -> Word8 -> Char

2434+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

2435+ where

2436+ !y1# = word2Int# x1#

2437+ !y2# = word2Int# x2#

2438+ !z1# = uncheckedIShiftL# (y1# -# 192#) 6#

2439+ !z2# = y2# -# 128#

2440+

2441+{-# INLINE chr3 #-}

2442+chr3 :: Word8 -> Word8 -> Word8 -> Char

2443+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))

2444+ where

2445+ !y1# = word2Int# x1#

2446+ !y2# = word2Int# x2#

2447+ !y3# = word2Int# x3#

2448+ !z1# = uncheckedIShiftL# (y1# -# 224#) 12#

2449+ !z2# = uncheckedIShiftL# (y2# -# 128#) 6#

2450+ !z3# = y3# -# 128#

2451+

2452+{-# INLINE chr4 #-}

2453+chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char

2454+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =

2455+ C# (chr# (z1# +# z2# +# z3# +# z4#))

2456+ where

2457+ !y1# = word2Int# x1#

2458+ !y2# = word2Int# x2#

2459+ !y3# = word2Int# x3#

2460+ !y4# = word2Int# x4#

2461+ !z1# = uncheckedIShiftL# (y1# -# 240#) 18#

2462+ !z2# = uncheckedIShiftL# (y2# -# 128#) 12#

2463+ !z3# = uncheckedIShiftL# (y3# -# 128#) 6#

2464+ !z4# = y4# -# 128#

2465+

2466+{-# INLINE between #-}

2467+between ::

2468+ Word8 -- ^ byte to check

2469+ -> Word8 -- ^ lower bound

2470+ -> Word8 -- ^ upper bound

2471+ -> Bool

2472+between x y z = x >= y && x <= z

2473+

2474+{-# INLINE validate3 #-}

2475+validate3 :: Word8 -> Word8 -> Word8 -> Bool

2476+validate3 x1 x2 x3 = validate3_1 ||

2477+ validate3_2 ||

2478+ validate3_3 ||

2479+ validate3_4

2480+ where

2481+ validate3_1 = (x1 == 0xE0) &&

2482+ between x2 0xA0 0xBF &&

2483+ between x3 0x80 0xBF

2484+ validate3_2 = between x1 0xE1 0xEC &&

2485+ between x2 0x80 0xBF &&

2486+ between x3 0x80 0xBF

2487+ validate3_3 = x1 == 0xED &&

2488+ between x2 0x80 0x9F &&

2489+ between x3 0x80 0xBF

2490+ validate3_4 = between x1 0xEE 0xEF &&

2491+ between x2 0x80 0xBF &&

2492+ between x3 0x80 0xBF

2493+

2494+{-# INLINE validate4 #-}

2495+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

2496+validate4 x1 x2 x3 x4 = validate4_1 ||

2497+ validate4_2 ||

2498+ validate4_3

2499+ where

2500+ validate4_1 = x1 == 0xF0 &&

2501+ between x2 0x90 0xBF &&

2502+ between x3 0x80 0xBF &&

2503+ between x4 0x80 0xBF

2504+ validate4_2 = between x1 0xF1 0xF3 &&

2505+ between x2 0x80 0xBF &&

2506+ between x3 0x80 0xBF &&

2507+ between x4 0x80 0xBF

2508+ validate4_3 = x1 == 0xF4 &&

2509+ between x2 0x80 0x8F &&

2510+ between x3 0x80 0xBF &&

2511+ between x4 0x80 0xBF

2512+

2513+data CodePoint = FreshPoint

2514+ | Two !Word8

2515+ | GoThree !Word8

2516+ | Three !Word8 !Word8

2517+ | GoFour !Word8

2518+ | Four1 !Word8 !Word8

2519+ | Four !Word8 !Word8 !Word8

2520+ | YieldPoint !Char

2521+

2522+{-# INLINE_NORMAL decodeUtf8 #-}

2523+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char

2524+decodeUtf8 (Stream step state) = Stream step' (state, FreshPoint)

2525+ where

2526+ {-# INLINE_LATE step' #-}

2527+ step' gst (st, FreshPoint) = do

2528+ r <- step (adaptState gst) st

2529+ return $

2530+ case r of

2531+ Yield c0 s

2532+ | c0 <= 0x7f ->

2533+ Skip (s, YieldPoint $ unsafeChr (fromIntegral c0))

2534+ | c0 >= 0xc0 && c0 <= 0xc1 -> error "Invalid Overlong forms"

2535+ | c0 >= 0xc2 && c0 <= 0xdf -> Skip (s, Two c0)

2536+ | c0 >= 0xe0 && c0 <= 0xef -> Skip (s, GoThree c0)

2537+ | c0 >= 0xf0 -> Skip (s, GoFour c0)

2538+ | otherwise -> error "Invalid Sequence"

2539+ Skip s -> Skip (s, FreshPoint)

2540+ Stop -> Stop

2541+

2542+ -- Decoding of a UTF8 character that spans two bytes with one byte (c0)

2543+ -- known.

2544+ step' gst (st, Two c0) = do

2545+ r <- step (adaptState gst) st

2546+ return $

2547+ case r of

2548+ Yield c1 s

2549+ | c1 < 0x80 || c1 >= 0xc0 -> error "Invalid Sequence"

2550+ | otherwise -> Skip (s, YieldPoint $ chr2 c0 c1)

2551+ Skip s -> Skip (s, Two c0)

2552+ Stop -> error "Input Underflow"

2553+

2554+ -- Decoding of a UTF8 character that spans three bytes with first byte (c0)

2555+ -- known.

2556+ step' gst (st, GoThree c0) = do

2557+ r <- step (adaptState gst) st

2558+ return $

2559+ case r of

2560+ Yield c1 s

2561+ | not (validate3 c0 c1 0x80) -> error "Invalid Sequence"

2562+ -- See #3341@ghc

2563+ | otherwise -> Skip (s, Three c0 c1)

2564+ Skip s -> Skip (s, GoThree c0)

2565+ Stop -> error "Input Underflow"

2566+

2567+ -- Two bytes known of a 3 byte UTF8 encoded unicode character.

2568+ step' gst (st, Three c0 c1) = do

2569+ r <- step (adaptState gst) st

2570+ return $

2571+ case r of

2572+ Yield c2 s

2573+ | not (validate3 c0 c1 c2) -> error "Invalid Sequence"

2574+ | otherwise -> Skip (s, YieldPoint $ chr3 c0 c1 c2)

2575+ Skip s -> Skip (s, Three c0 c1)

2576+ Stop -> error "Input Underflow"

2577+

2578+ -- One byte known of a four byte UTF8 unicode character.

2579+ step' gst (st, GoFour c0) = do

2580+ r <- step (adaptState gst) st

2581+ return $

2582+ case r of

2583+ Yield c1 s

2584+ | not (validate4 c0 c1 0x80 0x80) -> error "Invalid Sequence"

2585+ | otherwise -> Skip (s, Four1 c0 c1)

2586+ Skip s -> Skip (s, GoFour c0)

2587+ Stop -> error "Input Underflow"

2588+

2589+ -- Two bytes known of a four byte UTF8 unicode character.

2590+ step' gst (st, Four1 c0 c1) = do

2591+ r <- step (adaptState gst) st

2592+ return $

2593+ case r of

2594+ Yield c2 s

2595+ | not (validate4 c0 c1 c2 0x80) -> error "Invalid Sequence"

2596+ | otherwise -> Skip (s, Four c0 c1 c2)

2597+ Skip s -> Skip (s, Four1 c0 c1)

2598+ Stop -> error "Input Underflow"

2599+

2600+ -- Three bytes known of a three byte UTF8 unicode character.

2601+ step' gst (st, Four c0 c1 c2) = do

2602+ r <- step (adaptState gst) st

2603+ return $

2604+ case r of

2605+ Yield c3 s

2606+ | not (validate4 c0 c1 c2 c3) -> error "Invalid Sequence"

2607+ | otherwise -> Skip (s, YieldPoint $ chr4 c0 c1 c2 c3)

2608+ Skip s -> Skip (s, Four c0 c1 c2)

2609+ Stop -> error "Input Underflow"

2610+

2611+ -- This way so that we only need one Yield.

2612+ step' _ (s, YieldPoint c) = return $ Yield c (s, FreshPoint)

2613+

2614+data YieldMany x = None

2615+ | YieldMany !x

2616+

2617+{-# INLINE_NORMAL encodeUtf8 #-}

2618+encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8

2619+encodeUtf8 (Stream step state) = Stream step' (state, None)

2620+ where

2621+ {-# INLINE_LATE step' #-}

2622+ step' gst (st, None) = do

2623+ r <- step (adaptState gst) st

2624+ return $

2625+ case r of

2626+ Yield c s ->

2627+ case ord c of

2628+ x | x <= 0x7F -> Skip (s, YieldMany [fromIntegral x])

2629+ | x <= 0x7FF -> Skip (s, YieldMany (ord2 c))

2630+ | x <= 0xFFFF ->

2631+ if isSurrogate c

2632+ then error "Encountered a surrogate"

2633+ else Skip (s, YieldMany (ord3 c))

2634+ | otherwise -> Skip (s, YieldMany (ord4 c))

2635+ Skip s -> Skip (s, None)

2636+ Stop -> Stop

2637+ step' _ (s, YieldMany []) = return $ Skip (s, None)

2638+ step' _ (s, YieldMany (x:xs)) = return $ Yield x (s, YieldMany xs)

src/Streamly/Streams/StreamK.hs+5

@@ -143,6 +143,7 @@ module Streamly.Streams.StreamK

143

144 -- ** Inserting

145 , intersperseM

146+ , intersperse

146 , insertBy

147 , insertBy

147

148

148 -- ** Deleting

149 -- ** Deleting

@@ -826,6 +827,10 @@ intersperseM a m = prependingStart m

826 yieldk i x = foldStreamShared st yld sng stp $ a |: return i |: go x

827 yieldk i x = foldStreamShared st yld sng stp $ a |: return i |: go x

827 in foldStream st yieldk single stp m2

828 in foldStream st yieldk single stp m2

828

829

830+{-# INLINE intersperse #-}

831+intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a

832+intersperse a = intersperseM (return a)

833+

829{-# INLINE insertBy #-}

834{-# INLINE insertBy #-}

830insertBy :: IsStream t => (a -> a -> Ordering) -> a -> t m a -> t m a

835insertBy :: IsStream t => (a -> a -> Ordering) -> a -> t m a -> t m a

831insertBy cmp x m = go m

836insertBy cmp x m = go m

src/Streamly/String.hs+60−34

@@ -1,3 +1,4 @@

1+{-# LANGUAGE FlexibleContexts #-}

1-- |

2-- |

2-- Module : Streamly.String

3-- Module : Streamly.String

@@ -35,10 +36,10 @@ module Streamly.String

35 encodeChar8

36 encodeChar8

36 , encodeChar8Unchecked

37 , encodeChar8Unchecked

37 , decodeChar8

38 , decodeChar8

38−{-

39+

39 , encodeUtf8

40 , encodeUtf8

40 , decodeUtf8

41 , decodeUtf8

41−

42+{-

42 -- * Unicode aware operations

43 -- * Unicode aware operations

43 , toCaseFold

44 , toCaseFold

44 , toLower

45 , toLower

@@ -47,28 +48,31 @@ module Streamly.String

48 -- * Operations on character strings

49 -- * Operations on character strings

49 , strip -- (dropAround isSpace)

50 , strip -- (dropAround isSpace)

51+ , stripEnd-}

50 , stripStart

52 , stripStart

51− , stripEnd

52 , foldLines

53 , foldLines

53 , foldWords

54 , foldWords

54 , lines

55 , lines

55 , words

56 , words

56 , unlines

57 , unlines

57 , unwords

58 , unwords

58−-}

59 )

60where

62+import Control.Monad.IO.Class (MonadIO)

62import Data.Char (ord)

63import Data.Char (ord)

63import Data.Word (Word8)

64import Data.Word (Word8)

64import GHC.Base (unsafeChr)

65import GHC.Base (unsafeChr)

65−import Streamly (IsStream)

66+import Streamly (IsStream, MonadAsync)

66−-- import Streamly.List (List)

67import Prelude hiding (String, lines, words, unlines, unwords)

68−-- import Streamly.Fold (Fold)

68+import Streamly.Fold (Fold)

69−-- import Streamly.Array (Array)

69+import Streamly.Mem.Array (Array, toArray)

71import qualified Streamly.Prelude as S

72+import qualified Streamly.Fold as FL

73+import qualified Streamly.Mem.Array.Types as A (unlines)

74+import qualified Streamly.Mem.Array as A

75+import qualified Streamly.Streams.StreamD as D

73-- type String = List Char

77-- type String = List Char

@@ -110,15 +114,18 @@ encodeChar8 = S.map convert

110encodeChar8Unchecked :: (IsStream t, Monad m) => t m Char -> t m Word8

114encodeChar8Unchecked :: (IsStream t, Monad m) => t m Char -> t m Word8

111encodeChar8Unchecked = S.map (fromIntegral . ord)

115encodeChar8Unchecked = S.map (fromIntegral . ord)

112

116

113−{-

114-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.

117-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.

118+-- The incoming stream is truncated if an invalid codepoint is encountered.

119+{-# INLINE decodeUtf8 #-}

115−decodeUtf8 :: IsStream t => t m Word8 -> t m Char

120+decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char

116−decodeUtf8 = undefined

121+decodeUtf8 = D.fromStreamD . D.decodeUtf8 . D.toStreamD

117

122

118-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

123-- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream.

124+{-# INLINE encodeUtf8 #-}

119−encodeUtf8 :: IsStream t => t m Char -> t m Word8

125+encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8

120−encodeUtf8 = undefined

126+encodeUtf8 = D.fromStreamD . D.encodeUtf8 . D.toStreamD

121

127

128+{-

122-------------------------------------------------------------------------------

129-------------------------------------------------------------------------------

123-- Unicode aware operations on strings

130-- Unicode aware operations on strings

124-------------------------------------------------------------------------------

131-------------------------------------------------------------------------------

@@ -142,27 +149,46 @@ toTitle = undefined

142strip :: IsStream t => t m Char -> t m Char

149strip :: IsStream t => t m Char -> t m Char

143strip = undefined

150strip = undefined

144

151

145−stripStart :: IsStream t => t m Char -> t m Char

146−stripStart = undefined

147−

148stripEnd :: IsStream t => t m Char -> t m Char

152stripEnd :: IsStream t => t m Char -> t m Char

149stripEnd = undefined

153stripEnd = undefined

150−

151−foldLines :: IsStream t => t m Char -> Fold m Char b -> t m b

152−foldLines = undefined

153−

154−foldWords :: IsStream t => t m Char -> Fold m Char b -> t m b

155−foldWords = undefined

156−

157−lines :: IsStream t => t m Char -> t m (Array Char)

158−lines = undefined

159−

160−words :: IsStream t => t m Char -> t m (Array Char)

161−words = undefined

162−

163−unlines :: IsStream t => t m (Array Char) -> t m Char

164−unlines = undefined

165−

166−unwords :: IsStream t => t m (Array Char) -> t m Char

167−unwords = undefined

168-}

154-}

155+

156+{-# INLINE stripStart #-}

157+stripStart :: (Monad m, IsStream t) => t m Char -> t m Char

158+stripStart = S.dropWhile isSpace

159+

160+{-# INLINE foldLines #-}

161+foldLines :: (Monad m, IsStream t) => t m Char -> Fold m Char b -> t m b

162+foldLines = flip (FL.splitSuffixBy (== '\n'))

163+

164+{-# INLINE foldWords #-}

165+foldWords :: (Monad m, IsStream t) => t m Char -> Fold m Char b -> t m b

166+foldWords = flip (FL.wordsBy isSpace)

167+

168+foreign import ccall unsafe "u_iswspace"

169+ iswspace :: Int -> Int

170+

171+-- Code copied from base/Data.Char to INLINE it

172+{-# INLINE isSpace #-}

173+isSpace :: Char -> Bool

174+isSpace c

175+ | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0

176+ | otherwise = iswspace (ord c) /= 0

177+ where

178+ uc = fromIntegral (ord c) :: Word

179+

180+{-# INLINE lines #-}

181+lines :: (MonadIO m, IsStream t) => t m Char -> t m (Array Char)

182+lines = FL.splitSuffixBy (== '\n') toArray

183+

184+{-# INLINE words #-}

185+words :: (MonadIO m, IsStream t) => t m Char -> t m (Array Char)

186+words = FL.wordsBy isSpace toArray

187+

188+{-# INLINE unlines #-}

189+unlines :: (MonadIO m, IsStream t) => t m (Array Char) -> t m Char

190+unlines = D.fromStreamD . A.unlines . D.toStreamD

191+

192+{-# INLINE unwords #-}

193+unwords :: (MonadAsync m, IsStream t) => t m (Array Char) -> t m Char

194+unwords = A.flattenArrays . (S.intersperse (A.fromList " "))

streamly.cabal+29

@@ -421,6 +421,35 @@ test-suite array-test

421 transformers >= 0.4 && < 0.6

422 default-language: Haskell2010

423

424+test-suite string-test

425+ type: exitcode-stdio-1.0

426+ main-is: String.hs

427+ js-sources: jsbits/clock.js

428+ hs-source-dirs: test

429+ ghc-options: -fno-ignore-asserts -Wall -O0 -threaded -with-rtsopts=-N

430+ if flag(dev)

431+ cpp-options: -DDEVBUILD

432+ ghc-options: -Wmissed-specialisations

433+ -Wall-missed-specialisations

434+ if impl(ghc >= 8.0)

435+ ghc-options: -Wcompat

436+ -Wunrecognised-warning-flags

437+ -Widentities

438+ -Wincomplete-record-updates

439+ -Wincomplete-uni-patterns

440+ -Wredundant-constraints

441+ -Wnoncanonical-monad-instances

442+ -Wnoncanonical-monadfail-instances

443+ build-depends:

444+ streamly

445+ , base >= 4.8 && < 5

446+ , QuickCheck >= 2.10 && < 2.14

447+ , hspec >= 2.0 && < 3

448+ if impl(ghc < 8.0)

449+ build-depends:

450+ transformers >= 0.4 && < 0.6

451+ default-language: Haskell2010

452+

424test-suite maxrate

453test-suite maxrate

425 type: exitcode-stdio-1.0

454 type: exitcode-stdio-1.0

426 default-language: Haskell2010

455 default-language: Haskell2010

test/String.hsnew file+91

@@ -0,0 +1,91 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE FlexibleContexts #-}

4+module Main (main) where

6+import Test.Hspec.QuickCheck

7+import Test.QuickCheck (Property, forAll, Gen, listOf, arbitraryUnicodeChar)

8+import Test.QuickCheck.Monadic (run, monadicIO, assert)

10+import Test.Hspec as H

11+

12+import qualified Streamly.Mem.Array as A

13+import qualified Streamly.Prelude as S

14+import qualified Streamly.String as SS

15+

16+-- Coverage build takes too long with default number of tests

17+maxTestCount :: Int

18+#ifdef DEVBUILD

19+maxTestCount = 100

20+#else

21+maxTestCount = 10

22+#endif

23+

24+-- Use quickcheck-unicode instead?

25+genUnicode :: Gen String

26+genUnicode = listOf arbitraryUnicodeChar

27+

28+propDecodeEncodeId :: Property

29+propDecodeEncodeId =

30+ forAll genUnicode $ \list ->

31+ monadicIO $ do

32+ let wrds = SS.encodeUtf8 $ S.fromList list

33+ chrs <- S.toList $ SS.decodeUtf8 wrds

34+ assert (chrs == list)

35+

36+testLines :: Property

37+testLines =

38+ forAll genUnicode $ \list ->

39+ monadicIO $ do

40+ xs <- S.toList

41+ $ S.map A.toList

42+ $ SS.lines

43+ $ S.fromList list

44+ assert (xs == lines list)

45+

46+testWords :: Property

47+testWords =

48+ forAll genUnicode $ \list ->

49+ monadicIO $ do

50+ xs <- S.toList

51+ $ S.map A.toList

52+ $ SS.words

53+ $ S.fromList list

54+ assert (xs == words list)

55+

56+testUnlines :: Property

57+testUnlines =

58+ forAll genUnicode $ \list ->

59+ monadicIO $ do

60+ xs <- S.toList

61+ $ SS.unlines

62+ $ SS.lines

63+ $ S.fromList list

64+ assert (xs == unlines (lines list))

65+

66+testUnwords :: Property

67+testUnwords =

68+ forAll genUnicode $ \list ->

69+ monadicIO $ do

70+ xs <- run

71+ $ S.toList

72+ $ SS.unwords

73+ $ SS.words

74+ $ S.fromList list

75+ assert (xs == unwords (words list))

76+

77+main :: IO ()

78+main = hspec

79+ $ H.parallel

80+ $ modifyMaxSuccess (const 1000)

81+ $ do

82+ describe "UTF8 - Encoding / Decoding" $ do

83+ prop "decodeUtf8 . encodeUtf8 == id" $ propDecodeEncodeId

84+ prop "Streamly.String.lines == Prelude.lines" $ testLines

85+ prop "Streamly.String.words == Prelude.words" $ testWords

86+ prop

87+ "Streamly.String.unlines . Streamly.String.lines == unlines . lines"

88+ $ testUnlines

89+ prop

90+ "Streamly.String.unwords . Streamly.String.words == unwords . words"

91+ $ testUnwords