9034b2d · streamly · git.iko.soy

src/Streamly/Data/Unfold.hs−3

compare with master

unifiedsplit

@@ -1,12 +1,9 @@

1−{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

3{-# LANGUAGE ExistentialQuantification #-}

2{-# LANGUAGE ExistentialQuantification #-}

4{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE PatternSynonyms #-}

4{-# LANGUAGE PatternSynonyms #-}

6{-# LANGUAGE RankNTypes #-}

5{-# LANGUAGE RankNTypes #-}

7−{-# LANGUAGE RecordWildCards #-}

8{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE ScopedTypeVariables #-}

9−{-# LANGUAGE TupleSections #-}

10

7

11#include "inline.hs"

8#include "inline.hs"

12

9

src/Streamly/FileSystem/FD.hs+4−8

@@ -1,8 +1,4 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE MagicHash #-}

4−{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE UnboxedTuples #-}

6

2

7#include "inline.hs"

3#include "inline.hs"

8

4

@@ -204,7 +200,7 @@ stderr = Handle FD.stderr

204-- the same absolute path name and neither has been renamed, for example.

200-- the same absolute path name and neither has been renamed, for example.

205--

201--

206openFile :: FilePath -> IOMode -> IO Handle

202openFile :: FilePath -> IOMode -> IO Handle

207−openFile path mode = fmap (Handle . fst) $ FD.openFile path mode True

203+openFile path mode = Handle . fst <$> FD.openFile path mode True

208

204

209-------------------------------------------------------------------------------

205-------------------------------------------------------------------------------

210-- Array IO (Input)

206-- Array IO (Input)

@@ -241,7 +237,7 @@ readArrayUpto size (Handle fd) = do

241{-# INLINABLE writeArray #-}

237{-# INLINABLE writeArray #-}

242writeArray :: Storable a => Handle -> Array a -> IO ()

238writeArray :: Storable a => Handle -> Array a -> IO ()

243writeArray _ arr | A.length arr == 0 = return ()

239writeArray _ arr | A.length arr == 0 = return ()

244−writeArray (Handle fd) arr = withForeignPtr (aStart arr) $ \p -> do

240+writeArray (Handle fd) arr = withForeignPtr (aStart arr) $ \p ->

245 -- RawIO.writeAll fd (castPtr p) aLen

241 -- RawIO.writeAll fd (castPtr p) aLen

246 RawIO.write fd (castPtr p) aLen

242 RawIO.write fd (castPtr p) aLen

247 {-

243 {-

@@ -349,7 +345,7 @@ read = AS.concat . readArrays

349-- @since 0.7.0

345-- @since 0.7.0

350{-# INLINE writeArrays #-}

346{-# INLINE writeArrays #-}

351writeArrays :: (MonadIO m, Storable a) => Handle -> SerialT m (Array a) -> m ()

347writeArrays :: (MonadIO m, Storable a) => Handle -> SerialT m (Array a) -> m ()

352−writeArrays h m = S.mapM_ (liftIO . writeArray h) m

348+writeArrays h = S.mapM_ (liftIO . writeArray h)

353

349

354-- | Write a stream of arrays to a handle after coalescing them in chunks of

350-- | Write a stream of arrays to a handle after coalescing them in chunks of

355-- specified size. The chunk size is only a maximum and the actual writes could

351-- specified size. The chunk size is only a maximum and the actual writes could

@@ -369,7 +365,7 @@ writeArraysPackedUpto n h xs = writeArrays h $ AS.compact n xs

369-- @since 0.7.0

365-- @since 0.7.0

370{-# INLINE writev #-}

366{-# INLINE writev #-}

371writev :: MonadIO m => Handle -> SerialT m (Array RawIO.IOVec) -> m ()

367writev :: MonadIO m => Handle -> SerialT m (Array RawIO.IOVec) -> m ()

372−writev h m = S.mapM_ (liftIO . writeIOVec h) m

368+writev h = S.mapM_ (liftIO . writeIOVec h)

373

369

374-- XXX this is incomplete

370-- XXX this is incomplete

375-- | Write a stream of arrays to a handle after grouping them in 'IOVec' arrays

371-- | Write a stream of arrays to a handle after grouping them in 'IOVec' arrays

src/Streamly/FileSystem/FDIO.hs−3

@@ -1,8 +1,5 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE MagicHash #-}

4−{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE UnboxedTuples #-}

6

3

7#include "inline.hs"

4#include "inline.hs"

8

5

src/Streamly/FileSystem/Handle.hs−4

@@ -1,8 +1,4 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE BangPatterns #-}

3−{-# LANGUAGE MagicHash #-}

4−{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE UnboxedTuples #-}

6

2

7#include "inline.hs"

3#include "inline.hs"

8

4

src/Streamly/Internal/Mutable/Prim/Var.hs−2

@@ -1,9 +1,7 @@

1−{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE ConstraintKinds #-}

1{-# LANGUAGE ConstraintKinds #-}

3{-# LANGUAGE CPP #-}

2{-# LANGUAGE CPP #-}

4{-# LANGUAGE ExistentialQuantification #-}

3{-# LANGUAGE ExistentialQuantification #-}

5{-# LANGUAGE MagicHash #-}

4{-# LANGUAGE MagicHash #-}

6−{-# LANGUAGE RecordWildCards #-}

7{-# LANGUAGE UnboxedTuples #-}

5{-# LANGUAGE UnboxedTuples #-}

8{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE ScopedTypeVariables #-}

9

7

src/Streamly/Internal/Network/Inet/TCP.hs+3−8

@@ -1,9 +1,5 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE BangPatterns #-}

3{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE MagicHash #-}

5−{-# LANGUAGE RecordWildCards #-}

6−{-# LANGUAGE UnboxedTuples #-}

7

3

8#include "inline.hs"

4#include "inline.hs"

9

5

@@ -359,13 +355,12 @@ writeChunks addr port = Fold step initial extract

359 where

355 where

360 initial = do

356 initial = do

361 skt <- liftIO (connect addr port)

357 skt <- liftIO (connect addr port)

362− fld <- FL.initialize (SK.writeChunks skt)

358+ fld <- FL.initialize (SK.writeChunks skt) `MC.onException` liftIO (Net.close skt)

363− `MC.onException` (liftIO $ Net.close skt)

364 return (fld, skt)

359 return (fld, skt)

365 step (fld, skt) x = do

360 step (fld, skt) x = do

366− r <- FL.runStep fld x `MC.onException` (liftIO $ Net.close skt)

361+ r <- FL.runStep fld x `MC.onException` liftIO (Net.close skt)

367 return (r, skt)

362 return (r, skt)

368− extract ((Fold _ initial1 extract1), skt) = do

363+ extract (Fold _ initial1 extract1, skt) = do

369 liftIO $ Net.close skt

364 liftIO $ Net.close skt

370 initial1 >>= extract1

365 initial1 >>= extract1

371

366

src/Streamly/Internal/Network/Socket.hs+4−11

@@ -1,9 +1,6 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE BangPatterns #-}

3{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

4−{-# LANGUAGE MagicHash #-}

5{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

6−{-# LANGUAGE UnboxedTuples #-}

7

4

8#include "inline.hs"

5#include "inline.hs"

9

6

@@ -78,11 +75,10 @@ import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

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

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

79import Foreign.Storable (Storable(..))

76import Foreign.Storable (Storable(..))

80import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

77import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

81−import Network.Socket (sendBuf, recvBuf)

82import Network.Socket

78import Network.Socket

83 (Socket, SocketOption(..), Family(..), SockAddr(..),

79 (Socket, SocketOption(..), Family(..), SockAddr(..),

84 ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,

80 ProtocolNumber, withSocketsDo, SocketType(..), socket, bind,

85− setSocketOption)

81+ setSocketOption, sendBuf, recvBuf)

86#if MIN_VERSION_network(3,1,0)

82#if MIN_VERSION_network(3,1,0)

87import Network.Socket (withFdSocket)

83import Network.Socket (withFdSocket)

88#else

84#else

@@ -160,9 +156,7 @@ listenTuples :: MonadIO m

160 => Unfold m (Int, SockSpec, SockAddr) (Socket, SockAddr)

156 => Unfold m (Int, SockSpec, SockAddr) (Socket, SockAddr)

161listenTuples = Unfold step inject

157listenTuples = Unfold step inject

162 where

158 where

163− inject (listenQLen, spec, addr) = do

164− listener <- liftIO $ initListener listenQLen spec addr

159+ inject (listenQLen, spec, addr) = liftIO $ initListener listenQLen spec addr

165− return listener

166

160

167 step listener = do

161 step listener = do

168 r <- liftIO $ Net.accept listener

162 r <- liftIO $ Net.accept listener

@@ -208,8 +202,7 @@ recvConnectionTuplesWith tcpListenQ spec addr = S.unfoldrM step Nothing

208-- /Internal/

202-- /Internal/

209{-# INLINE connections #-}

203{-# INLINE connections #-}

210connections :: MonadAsync m => Int -> SockSpec -> SockAddr -> SerialT m Socket

204connections :: MonadAsync m => Int -> SockSpec -> SockAddr -> SerialT m Socket

211−connections tcpListenQ spec addr = fmap fst $

212− recvConnectionTuplesWith tcpListenQ spec addr

205+connections tcpListenQ spec addr = fst <$> recvConnectionTuplesWith tcpListenQ spec addr

213

206

214-------------------------------------------------------------------------------

207-------------------------------------------------------------------------------

215-- Array IO (Input)

208-- Array IO (Input)

@@ -416,7 +409,7 @@ read = UF.supplyFirst readWithBufferOf A.defaultChunkSize

416{-# INLINE fromChunks #-}

409{-# INLINE fromChunks #-}

417fromChunks :: (MonadIO m, Storable a)

410fromChunks :: (MonadIO m, Storable a)

418 => Socket -> SerialT m (Array a) -> m ()

411 => Socket -> SerialT m (Array a) -> m ()

419−fromChunks h m = S.mapM_ (liftIO . writeChunk h) m

412+fromChunks h = S.mapM_ (liftIO . writeChunk h)

420

413

421-- | Write a stream of arrays to a socket. Each array in the stream is written

414-- | Write a stream of arrays to a socket. Each array in the stream is written

422-- to the socket as a separate IO request.

415-- to the socket as a separate IO request.

src/Streamly/Memory/Array.hs−4

@@ -1,8 +1,4 @@

1−{-# LANGUAGE BangPatterns #-}

2{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

3−{-# LANGUAGE MagicHash #-}

4−{-# LANGUAGE RecordWildCards #-}

5−{-# LANGUAGE UnboxedTuples #-}

6{-# LANGUAGE ScopedTypeVariables #-}

2{-# LANGUAGE ScopedTypeVariables #-}

7

3

8#include "inline.hs"

4#include "inline.hs"

src/Streamly/Memory/Malloc.hs+2−6

@@ -1,11 +1,7 @@

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE BangPatterns #-}

3{-# LANGUAGE ExistentialQuantification #-}

2{-# LANGUAGE ExistentialQuantification #-}

4−{-# LANGUAGE MagicHash #-}

5−{-# LANGUAGE RecordWildCards #-}

6{-# LANGUAGE ScopedTypeVariables #-}

3{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

4{-# LANGUAGE TypeFamilies #-}

8−{-# LANGUAGE UnboxedTuples #-}

9{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleContexts #-}

10

6

11#include "inline.hs"

7#include "inline.hs"

@@ -40,8 +36,8 @@ import qualified GHC.ForeignPtr as GHC

40{-# INLINE mallocForeignPtrAlignedBytes #-}

36{-# INLINE mallocForeignPtrAlignedBytes #-}

41mallocForeignPtrAlignedBytes :: Int -> Int -> IO (GHC.ForeignPtr a)

37mallocForeignPtrAlignedBytes :: Int -> Int -> IO (GHC.ForeignPtr a)

42#ifdef USE_GHC_MALLOC

38#ifdef USE_GHC_MALLOC

43−mallocForeignPtrAlignedBytes size alignment = do

39+mallocForeignPtrAlignedBytes =

44− GHC.mallocPlainForeignPtrAlignedBytes size alignment

40+ GHC.mallocPlainForeignPtrAlignedBytes

45#else

41#else

46mallocForeignPtrAlignedBytes size _alignment = do

42mallocForeignPtrAlignedBytes size _alignment = do

47 p <- mallocBytes size

43 p <- mallocBytes size

src/Streamly/Memory/Ring.hs+2−2

@@ -69,7 +69,7 @@ new count = do

69 let size = count * sizeOf (undefined :: a)

70 fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))

71 let p = unsafeForeignPtrToPtr fptr

72− return $ (Ring

72+ return (Ring

73 { ringStart = fptr

74 , ringBound = p `plusPtr` size

75 }, p)

@@ -105,7 +105,7 @@ unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool

105unsafeEqArrayN Ring{..} rh A.Array{..} n =

106 let !res = A.unsafeInlineIO $ do

107 let rs = unsafeForeignPtrToPtr ringStart

108− let as = unsafeForeignPtrToPtr aStart

108+ as = unsafeForeignPtrToPtr aStart

109 assert (aBound `minusPtr` as >= ringBound `minusPtr` rs) (return ())

110 let len = ringBound `minusPtr` rh

111 r1 <- A.memcmp (castPtr rh) (castPtr as) (min len n)