0759821 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Move Exception benchmarks from FileSystem.Handle to other modules

0759821Anurag Hooda6 years ago

benchmark/Streamly/Benchmark/FileSystem/Handle/Common.hs → benchmark/Streamly/Benchmark/CommonH.hsrenamed+63−1

compare with master

unifiedsplit

@@ -19,7 +19,7 @@

19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20#endif

22−module Handle.Common

22+module Streamly.Benchmark.CommonH

23 ( BenchEnv (..)

24 , RefHandles (..)

25 , scratchDir

@@ -30,6 +30,7 @@ module Handle.Common

30 , mkBenchSmall

31 , isSpace

32 , isSp

33+ , mkBenchEnv

33 )

34 )

34where

35where

@@ -41,6 +42,12 @@ import System.IO (openFile, IOMode(..), Handle, hClose)

41import Data.IORef

42import Data.IORef

42import Gauge hiding (env)

43import Gauge hiding (env)

45+import System.Directory (getFileSize)

46+import System.Environment (lookupEnv)

47+-- import System.IO (openFile, IOMode(..))

48+import System.Process.Typed (shell, runProcess_)

49+import Prelude hiding (last, length)

50+

44scratchDir :: String

51scratchDir :: String

45scratchDir = "benchmark-tmp/"

52scratchDir = "benchmark-tmp/"

@@ -152,3 +159,58 @@ isSpace c

152{-# INLINE isSp #-}

159{-# INLINE isSp #-}

153isSp :: Word8 -> Bool

160isSp :: Word8 -> Bool

154isSp = isSpace . chr . fromIntegral

161isSp = isSpace . chr . fromIntegral

162+

163+smallFileSize :: Int

164+smallFileSize = 10 * 1024 * 1024

165+

166+bigFileSize :: Int

167+bigFileSize = 100 * 1024 * 1024

168+

169+-- Function to create a BenchEnv

170+mkBenchEnv :: String -> IO BenchEnv

171+mkBenchEnv envName = do

172+ r <- lookupEnv envName

173+ (small, big) <-

174+ case r of

175+ Just inFileName -> return (inFileName, inFileName)

176+ Nothing -> do

177+ -- XXX will this work on windows/msys?

178+ let cmd infile size =

179+ "mkdir -p " ++ scratchDir

180+ ++ "; test -e " ++ infile

181+ ++ " || { echo \"creating input file " ++ infile

182+ ++ "\" && head -c " ++ show size

183+ ++ " </dev/urandom >" ++ infile

184+ ++ ";}"

185+ runProcess_ (shell (cmd inFileSmall smallFileSize))

186+ runProcess_ (shell (cmd inFileBig bigFileSize))

187+ return (inFileSmall, inFileBig)

188+

189+ putStrLn $ "Using small input file: " ++ small

190+ smallHandle <- openFile small ReadMode

191+

192+ putStrLn $ "Using big input file: " ++ big

193+ bigHandle <- openFile big ReadMode

194+

195+ putStrLn $ "Using output file: " ++ outfile

196+ outHandle <- openFile outfile WriteMode

197+ devNull <- openFile "/dev/null" WriteMode

198+

199+ ssize <- fromIntegral <$> getFileSize small

200+ bsize <- fromIntegral <$> getFileSize big

201+

202+ ref <- newIORef $ RefHandles

203+ { smallInH = smallHandle

204+ , bigInH = bigHandle

205+ , outputH = outHandle

206+ }

207+

208+ let env = BenchEnv

209+ { href = ref

210+ , smallSize = ssize

211+ , bigSize = bsize

212+ , nullH = devNull

213+ , smallInFile = small

214+ , bigInFile = big

215+ }

216+ return env

benchmark/Streamly/Benchmark/Data/Unfold.hs+104−1

@@ -6,6 +6,17 @@

6-- Maintainer : streamly@composewell.com

8{-# LANGUAGE FlexibleContexts #-}

9+{-# LANGUAGE CPP #-}

10+{-# LANGUAGE ScopedTypeVariables #-}

11+

12+#ifdef __HADDOCK_VERSION__

13+#undef INSPECTION

14+#endif

15+

16+#ifdef INSPECTION

17+{-# LANGUAGE TemplateHaskell #-}

18+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

19+#endif

10module Main (main) where

21module Main (main) where

@@ -21,6 +32,14 @@ import qualified Streamly.Internal.Data.Stream.StreamD as D

21import qualified Streamly.Internal.Data.Stream.StreamK as K

32import qualified Streamly.Internal.Data.Stream.StreamK as K

22import qualified Streamly.Benchmark.Data.NestedUnfoldOps as Nested

33import qualified Streamly.Benchmark.Data.NestedUnfoldOps as Nested

35+-- For Unfold Exception Benchmarks

36+import qualified Streamly.FileSystem.Handle as FH

37+import qualified Streamly.Internal.Data.Unfold as IUF

38+import qualified Streamly.Prelude as SP

39+import Streamly.Benchmark.CommonH

40+import System.IO (Handle, hClose, hPutChar)

41+import Control.Exception (SomeException)

42+

24import Streamly.Benchmark.Common

43import Streamly.Benchmark.Common

25import Gauge

44import Gauge

26import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)

45import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)

@@ -409,6 +428,7 @@ _apDiscardFst = undefined

409_apDiscardSnd :: Int -> Int -> m ()

428_apDiscardSnd :: Int -> Int -> m ()

410_apDiscardSnd = undefined

429_apDiscardSnd = undefined

411

430

431+

412-------------------------------------------------------------------------------

432-------------------------------------------------------------------------------

413-- Benchmarks

433-- Benchmarks

414-------------------------------------------------------------------------------

434-------------------------------------------------------------------------------

@@ -532,6 +552,83 @@ o_n_space_nested size =

532 ]

552 ]

533 ]

553 ]

534

554

555+-------------------------------------------------------------------------------

556+-- Unfold Exception Benchmarks

557+-------------------------------------------------------------------------------

558+-- | Send the file contents to /dev/null with exception handling

559+readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()

560+readWriteOnExceptionUnfold inh devNull =

561+ let readEx = IUF.onException (\_ -> hClose inh) FH.read

562+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh

563+

564+#ifdef INSPECTION

565+inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold

566+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step

567+#endif

568+

569+-- | Send the file contents to /dev/null with exception handling

570+readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()

571+readWriteHandleExceptionUnfold inh devNull =

572+ let handler (_e :: SomeException) = hClose inh >> return 10

573+ readEx = IUF.handle (IUF.singletonM handler) FH.read

574+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh

575+

576+#ifdef INSPECTION

577+inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold

578+-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step

579+#endif

580+

581+-- | Send the file contents to /dev/null with exception handling

582+readWriteFinally_Unfold :: Handle -> Handle -> IO ()

583+readWriteFinally_Unfold inh devNull =

584+ let readEx = IUF.finally_ (\_ -> hClose inh) FH.read

585+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh

586+

587+#ifdef INSPECTION

588+inspect $ hasNoTypeClasses 'readWriteFinally_Unfold

589+-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step

590+#endif

591+

592+readWriteFinallyUnfold :: Handle -> Handle -> IO ()

593+readWriteFinallyUnfold inh devNull =

594+ let readEx = IUF.finally (\_ -> hClose inh) FH.read

595+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh

596+

597+-- | Send the file contents to /dev/null with exception handling

598+readWriteBracket_Unfold :: Handle -> Handle -> IO ()

599+readWriteBracket_Unfold inh devNull =

600+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.read

601+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh

602+

603+#ifdef INSPECTION

604+inspect $ hasNoTypeClasses 'readWriteBracket_Unfold

605+-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step

606+#endif

607+

608+readWriteBracketUnfold :: Handle -> Handle -> IO ()

609+readWriteBracketUnfold inh devNull =

610+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.read

611+ in SP.fold (FH.write devNull) $ S.unfold readEx inh

612+

613+o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]

614+o_1_space_copy_read_exceptions env =

615+ [ bgroup "copy/read/exceptions"

616+ [ mkBenchSmall "UF.onException" env $ \inh _ ->

617+ readWriteOnExceptionUnfold inh (nullH env)

618+ , mkBenchSmall "UF.handle" env $ \inh _ ->

619+ readWriteHandleExceptionUnfold inh (nullH env)

620+ , mkBenchSmall "UF.finally_" env $ \inh _ ->

621+ readWriteFinally_Unfold inh (nullH env)

622+ , mkBenchSmall "UF.finally" env $ \inh _ ->

623+ readWriteFinallyUnfold inh (nullH env)

624+ , mkBenchSmall "UF.bracket_" env $ \inh _ ->

625+ readWriteBracket_Unfold inh (nullH env)

626+ , mkBenchSmall "UF.bracket" env $ \inh _ ->

627+ readWriteBracketUnfold inh (nullH env)

628+ ]

629+ ]

630+

631+

535-------------------------------------------------------------------------------

632-------------------------------------------------------------------------------

536-- Driver

633-- Driver

537-------------------------------------------------------------------------------

634-------------------------------------------------------------------------------

@@ -539,7 +636,9 @@ o_n_space_nested size =

539main :: IO ()

636main :: IO ()

540main = do

637main = do

541 (size, cfg, benches) <- parseCLIOpts defaultStreamSize

638 (size, cfg, benches) <- parseCLIOpts defaultStreamSize

639+ env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

542− size `seq` runMode (mode cfg) cfg benches (allBenchmarks size)

640+ size `seq` runMode (mode cfg) cfg benches (allBenchmarks size <>

641+ allBenchmarks' env)

543

642

544 where

643 where

545

644

@@ -552,7 +651,11 @@ main = do

552 , o_1_space_filtering size

651 , o_1_space_filtering size

553 , o_1_space_zip size

652 , o_1_space_zip size

554 , o_1_space_nested size

653 , o_1_space_nested size

654+ -- I have to pass BenchEnv instead of size here

655+ -- DONE

656+ -- , o_1_space_copy_read_exceptions env

555 ]

657 ]

556 , bgroup (o_n_space_prefix moduleName)

658 , bgroup (o_n_space_prefix moduleName)

557 $ Prelude.concat [o_n_space_nested size]

659 $ Prelude.concat [o_n_space_nested size]

558 ]

660 ]

661+ allBenchmarks' = o_1_space_copy_read_exceptions

benchmark/Streamly/Benchmark/FileSystem/Handle.hs+53−49

@@ -33,7 +33,10 @@ import qualified Handle.Read as RO

33import Data.IORef

34import Gauge hiding (env)

35import Streamly.Benchmark.Common

36+-- TBD Change it to point to Common in parent directory

37+-- Done

36−import Handle.Common

38+-- import Handle.Common

39+import Streamly.Benchmark.CommonH

38-------------------------------------------------------------------------------

41-------------------------------------------------------------------------------

39--

42--

@@ -46,11 +49,11 @@ moduleName = "FileSystem.Handle"

46--

49--

47-------------------------------------------------------------------------------

50-------------------------------------------------------------------------------

49−smallFileSize :: Int

52+-- smallFileSize :: Int

50−smallFileSize = 10 * 1024 * 1024

53+-- smallFileSize = 10 * 1024 * 1024

52−bigFileSize :: Int

55+-- bigFileSize :: Int

53−bigFileSize = 100 * 1024 * 1024

56+-- bigFileSize = 100 * 1024 * 1024

55-------------------------------------------------------------------------------

58-------------------------------------------------------------------------------

56--

59--

@@ -59,50 +62,51 @@ bigFileSize = 100 * 1024 * 1024

59main :: IO ()

62main :: IO ()

60main = do

63main = do

61 (_, cfg, benches) <- parseCLIOpts defaultStreamSize

64 (_, cfg, benches) <- parseCLIOpts defaultStreamSize

65+ env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

62− r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"

66+ -- r <- lookupEnv "Benchmark_FileSystem_Handle_InputFile"

63− (small, big) <-

67+ -- (small, big) <-

64− case r of

68+ -- case r of

65− Just inFileName -> return (inFileName, inFileName)

69+ -- Just inFileName -> return (inFileName, inFileName)

66− Nothing -> do

70+ -- Nothing -> do

67− -- XXX will this work on windows/msys?

71+ -- -- XXX will this work on windows/msys?

68− let cmd infile size =

72+ -- let cmd infile size =

69− "mkdir -p " ++ scratchDir

73+ -- "mkdir -p " ++ scratchDir

70− ++ "; test -e " ++ infile

74+ -- ++ "; test -e " ++ infile

71− ++ " || { echo \"creating input file " ++ infile

75+ -- ++ " || { echo \"creating input file " ++ infile

72− ++ "\" && head -c " ++ show size

76+ -- ++ "\" && head -c " ++ show size

73− ++ " </dev/urandom >" ++ infile

77+ -- ++ " </dev/urandom >" ++ infile

74− ++ ";}"

78+ -- ++ ";}"

75− runProcess_ (shell (cmd inFileSmall smallFileSize))

79+ -- runProcess_ (shell (cmd inFileSmall smallFileSize))

76− runProcess_ (shell (cmd inFileBig bigFileSize))

80+ -- runProcess_ (shell (cmd inFileBig bigFileSize))

77− return (inFileSmall, inFileBig)

81+ -- return (inFileSmall, inFileBig)

78−

82+

79− putStrLn $ "Using small input file: " ++ small

83+ -- putStrLn $ "Using small input file: " ++ small

80− smallHandle <- openFile small ReadMode

84+ -- smallHandle <- openFile small ReadMode

81−

85+

82− putStrLn $ "Using big input file: " ++ big

86+ -- putStrLn $ "Using big input file: " ++ big

83− bigHandle <- openFile big ReadMode

87+ -- bigHandle <- openFile big ReadMode

84−

88+

85− putStrLn $ "Using output file: " ++ outfile

89+ -- putStrLn $ "Using output file: " ++ outfile

86− outHandle <- openFile outfile WriteMode

90+ -- outHandle <- openFile outfile WriteMode

87− devNull <- openFile "/dev/null" WriteMode

91+ -- devNull <- openFile "/dev/null" WriteMode

88−

92+

89− ssize <- fromIntegral <$> getFileSize small

93+ -- ssize <- fromIntegral <$> getFileSize small

90− bsize <- fromIntegral <$> getFileSize big

94+ -- bsize <- fromIntegral <$> getFileSize big

91−

95+

92− ref <- newIORef $ RefHandles

96+ -- ref <- newIORef $ RefHandles

93− { smallInH = smallHandle

97+ -- { smallInH = smallHandle

94− , bigInH = bigHandle

98+ -- , bigInH = bigHandle

95− , outputH = outHandle

99+ -- , outputH = outHandle

96− }

100+ -- }

97−

101+

98− let env = BenchEnv

102+ -- let env = BenchEnv

99− { href = ref

103+ -- { href = ref

100− , smallSize = ssize

104+ -- , smallSize = ssize

101− , bigSize = bsize

105+ -- , bigSize = bsize

102− , nullH = devNull

106+ -- , nullH = devNull

103− , smallInFile = small

107+ -- , smallInFile = small

104− , bigInFile = big

108+ -- , bigInFile = big

105− }

109+ -- }

106

110

107 runMode (mode cfg) cfg benches (allBenchmarks env)

111 runMode (mode cfg) cfg benches (allBenchmarks env)

108

112

benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+2−1

@@ -50,7 +50,8 @@ import qualified Streamly.Internal.Data.Stream.IsStream as IP

50import qualified Streamly.Prelude as S

52import Gauge hiding (env)

53−import Handle.Common

53+-- import Handle.Common

54+import Streamly.Benchmark.CommonH

55#ifdef INSPECTION

56#ifdef INSPECTION

56import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)

57import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)

benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+2−265

@@ -41,7 +41,8 @@ import qualified Streamly.Data.Array.Storable.Foreign as A

41import qualified Streamly.Prelude as S

43import Gauge hiding (env)

44−import Handle.Common

44+-- import Handle.Common

45+import Streamly.Benchmark.CommonH

46#ifdef INSPECTION

47#ifdef INSPECTION

47import Foreign.Storable (Storable)

48import Foreign.Storable (Storable)

@@ -93,87 +94,6 @@ o_1_space_copy_chunked env =

93 ]

94 ]

95 ]

96−-- TBD reading with unfold

97−

98−-------------------------------------------------------------------------------

99−-- Exceptions readChunks

100−-------------------------------------------------------------------------------

101−

102−-- | Send the file contents to /dev/null with exception handling

103−readChunksOnException :: Handle -> Handle -> IO ()

104−readChunksOnException inh devNull =

105− let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks

106− in IUF.fold readEx (IFH.writeChunks devNull) inh

107−

108−#ifdef INSPECTION

109−inspect $ hasNoTypeClasses 'readChunksOnException

110−-- inspect $ 'readChunksOnException `hasNoType` ''Step

111−#endif

112−

113−-- | Send the file contents to /dev/null with exception handling

114−readChunksBracket_ :: Handle -> Handle -> IO ()

115−readChunksBracket_ inh devNull =

116− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks

117− in IUF.fold readEx (IFH.writeChunks devNull) inh

118−

119−#ifdef INSPECTION

120−inspect $ hasNoTypeClasses 'readChunksBracket_

121−-- inspect $ 'readChunksBracket `hasNoType` ''Step

122−#endif

123−

124−readChunksBracket :: Handle -> Handle -> IO ()

125−readChunksBracket inh devNull =

126− let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks

127− in IUF.fold readEx (IFH.writeChunks devNull) inh

128−

129−o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]

130−o_1_space_copy_exceptions_readChunks env =

131− [ bgroup "copy/readChunks/exceptions"

132− [ mkBench "UF.onException" env $ \inH _ ->

133− readChunksOnException inH (nullH env)

134− , mkBench "UF.bracket_" env $ \inH _ ->

135− readChunksBracket_ inH (nullH env)

136− , mkBench "UF.bracket" env $ \inH _ ->

137− readChunksBracket inH (nullH env)

138− ]

139− ]

140−

141−-------------------------------------------------------------------------------

142−-- Exceptions toChunks

143−-------------------------------------------------------------------------------

144−

145−-- | Send the file contents to /dev/null with exception handling

146−toChunksBracket_ :: Handle -> Handle -> IO ()

147−toChunksBracket_ inh devNull =

148− let readEx = IP.bracket_

149− (return ())

150− (\_ -> hClose inh)

151− (\_ -> IFH.toChunks inh)

152− in S.fold (IFH.writeChunks devNull) $ readEx

153−

154−#ifdef INSPECTION

155−inspect $ hasNoTypeClasses 'toChunksBracket_

156−-- inspect $ 'toChunksBracket `hasNoType` ''Step

157−#endif

158−

159−toChunksBracket :: Handle -> Handle -> IO ()

160−toChunksBracket inh devNull =

161− let readEx = S.bracket

162− (return ())

163− (\_ -> hClose inh)

164− (\_ -> IFH.toChunks inh)

165− in S.fold (IFH.writeChunks devNull) $ readEx

166−

167−o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]

168−o_1_space_copy_exceptions_toChunks env =

169− [ bgroup "copy/toChunks/exceptions"

170− [ mkBench "S.bracket_" env $ \inH _ ->

171− toChunksBracket_ inH (nullH env)

172− , mkBench "S.bracket" env $ \inH _ ->

173− toChunksBracket inH (nullH env)

174− ]

175− ]

176−

177-------------------------------------------------------------------------------

97-------------------------------------------------------------------------------

178-- copy unfold

98-- copy unfold

179-------------------------------------------------------------------------------

99-------------------------------------------------------------------------------

@@ -383,185 +303,6 @@ o_1_space_copy env =

383 ]

303 ]

384 ]

304 ]

385

305

386−-------------------------------------------------------------------------------

387−-- unfold exceptions

388−-------------------------------------------------------------------------------

389−

390−-- | Send the file contents to /dev/null with exception handling

391−{-# NOINLINE readWriteOnExceptionUnfold #-}

392−readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()

393−readWriteOnExceptionUnfold inh devNull =

394− let readEx = IUF.onException (\_ -> hClose inh) FH.read

395− in S.fold (FH.write devNull) $ S.unfold readEx inh

396−

397−#ifdef INSPECTION

398−inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold

399−-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step

400−#endif

401−

402−-- | Send the file contents to /dev/null with exception handling

403−{-# NOINLINE readWriteHandleExceptionUnfold #-}

404−readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()

405−readWriteHandleExceptionUnfold inh devNull =

406− let handler (_e :: SomeException) = hClose inh >> return 10

407− readEx = IUF.handle (IUF.singletonM handler) FH.read

408− in S.fold (FH.write devNull) $ S.unfold readEx inh

409−

410−#ifdef INSPECTION

411−inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold

412−-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step

413−#endif

414−

415−-- | Send the file contents to /dev/null with exception handling

416−{-# NOINLINE readWriteFinally_Unfold #-}

417−readWriteFinally_Unfold :: Handle -> Handle -> IO ()

418−readWriteFinally_Unfold inh devNull =

419− let readEx = IUF.finally_ (\_ -> hClose inh) FH.read

420− in S.fold (FH.write devNull) $ S.unfold readEx inh

421−

422−#ifdef INSPECTION

423−inspect $ hasNoTypeClasses 'readWriteFinally_Unfold

424−-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step

425−#endif

426−

427−{-# NOINLINE readWriteFinallyUnfold #-}

428−readWriteFinallyUnfold :: Handle -> Handle -> IO ()

429−readWriteFinallyUnfold inh devNull =

430− let readEx = IUF.finally (\_ -> hClose inh) FH.read

431− in S.fold (FH.write devNull) $ S.unfold readEx inh

432−

433−-- | Send the file contents to /dev/null with exception handling

434−{-# NOINLINE readWriteBracket_Unfold #-}

435−readWriteBracket_Unfold :: Handle -> Handle -> IO ()

436−readWriteBracket_Unfold inh devNull =

437− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.read

438− in S.fold (FH.write devNull) $ S.unfold readEx inh

439−

440−#ifdef INSPECTION

441−inspect $ hasNoTypeClasses 'readWriteBracket_Unfold

442−-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step

443−#endif

444−

445−{-# NOINLINE readWriteBracketUnfold #-}

446−readWriteBracketUnfold :: Handle -> Handle -> IO ()

447−readWriteBracketUnfold inh devNull =

448− let readEx = IUF.bracket return (\_ -> hClose inh) FH.read

449− in S.fold (FH.write devNull) $ S.unfold readEx inh

450−

451−o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]

452−o_1_space_copy_read_exceptions env =

453− [ bgroup "copy/read/exceptions"

454− [ mkBenchSmall "UF.onException" env $ \inh _ ->

455− readWriteOnExceptionUnfold inh (nullH env)

456− , mkBenchSmall "UF.handle" env $ \inh _ ->

457− readWriteHandleExceptionUnfold inh (nullH env)

458− , mkBenchSmall "UF.finally_" env $ \inh _ ->

459− readWriteFinally_Unfold inh (nullH env)

460− , mkBenchSmall "UF.finally" env $ \inh _ ->

461− readWriteFinallyUnfold inh (nullH env)

462− , mkBenchSmall "UF.bracket_" env $ \inh _ ->

463− readWriteBracket_Unfold inh (nullH env)

464− , mkBenchSmall "UF.bracket" env $ \inh _ ->

465− readWriteBracketUnfold inh (nullH env)

466− ]

467− ]

468−

469−-------------------------------------------------------------------------------

470−-- stream exceptions

471−-------------------------------------------------------------------------------

472−

473−-- | Send the file contents to /dev/null with exception handling

474−{-# NOINLINE readWriteOnExceptionStream #-}

475−readWriteOnExceptionStream :: Handle -> Handle -> IO ()

476−readWriteOnExceptionStream inh devNull =

477− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)

478− in S.fold (FH.write devNull) $ readEx

479−

480−-- | Send the file contents to /dev/null with exception handling

481−{-# NOINLINE readWriteHandleExceptionStream #-}

482−readWriteHandleExceptionStream :: Handle -> Handle -> IO ()

483−readWriteHandleExceptionStream inh devNull =

484− let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)

485− readEx = S.handle handler (S.unfold FH.read inh)

486− in S.fold (FH.write devNull) $ readEx

487−

488−-- | Send the file contents to /dev/null with exception handling

489−{-# NOINLINE readWriteFinally_Stream #-}

490−readWriteFinally_Stream :: Handle -> Handle -> IO ()

491−readWriteFinally_Stream inh devNull =

492− let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)

493− in S.fold (FH.write devNull) readEx

494−

495−{-# NOINLINE readWriteFinallyStream #-}

496−readWriteFinallyStream :: Handle -> Handle -> IO ()

497−readWriteFinallyStream inh devNull =

498− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)

499− in S.fold (FH.write devNull) readEx

500−

501−-- | Send the file contents to /dev/null with exception handling

502−fromToBytesBracket_Stream :: Handle -> Handle -> IO ()

503−fromToBytesBracket_Stream inh devNull =

504− let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)

505− (\_ -> IFH.toBytes inh)

506− in IFH.fromBytes devNull $ readEx

507−

508−#ifdef INSPECTION

509−inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream

510−-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step

511−#endif

512−

513−fromToBytesBracketStream :: Handle -> Handle -> IO ()

514−fromToBytesBracketStream inh devNull =

515− let readEx = S.bracket (return ()) (\_ -> hClose inh)

516− (\_ -> IFH.toBytes inh)

517− in IFH.fromBytes devNull $ readEx

518−

519−{-# NOINLINE readWriteBeforeAfterStream #-}

520−readWriteBeforeAfterStream :: Handle -> Handle -> IO ()

521−readWriteBeforeAfterStream inh devNull =

522− let readEx =

523− IP.after (hClose inh)

524− $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)

525− in S.fold (FH.write devNull) readEx

526−

527−{-# NOINLINE readWriteAfterStream #-}

528−readWriteAfterStream :: Handle -> Handle -> IO ()

529−readWriteAfterStream inh devNull =

530− let readEx = IP.after (hClose inh) (S.unfold FH.read inh)

531− in S.fold (FH.write devNull) readEx

532−

533−{-# NOINLINE readWriteAfter_Stream #-}

534−readWriteAfter_Stream :: Handle -> Handle -> IO ()

535−readWriteAfter_Stream inh devNull =

536− let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)

537− in S.fold (FH.write devNull) readEx

538−

539−o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]

540−o_1_space_copy_stream_exceptions env =

541− [ bgroup "copy/read/exceptions"

542− [ mkBenchSmall "S.onException" env $ \inh _ ->

543− readWriteOnExceptionStream inh (nullH env)

544− , mkBenchSmall "S.handle" env $ \inh _ ->

545− readWriteHandleExceptionStream inh (nullH env)

546− , mkBenchSmall "S.finally_" env $ \inh _ ->

547− readWriteFinally_Stream inh (nullH env)

548− , mkBenchSmall "S.finally" env $ \inh _ ->

549− readWriteFinallyStream inh (nullH env)

550− , mkBenchSmall "S.after . S.before" env $ \inh _ ->

551− readWriteBeforeAfterStream inh (nullH env)

552− , mkBenchSmall "S.after" env $ \inh _ ->

553− readWriteAfterStream inh (nullH env)

554− , mkBenchSmall "S.after_" env $ \inh _ ->

555− readWriteAfter_Stream inh (nullH env)

556− ]

557− , bgroup "copy/fromToBytes/exceptions"

558− [ mkBenchSmall "S.bracket_" env $ \inh _ ->

559− fromToBytesBracket_Stream inh (nullH env)

560− , mkBenchSmall "S.bracket" env $ \inh _ ->

561− fromToBytesBracketStream inh (nullH env)

562− ]

563− ]

564−

565-------------------------------------------------------------------------------

306-------------------------------------------------------------------------------

566-- copy with group/ungroup transformations

307-- copy with group/ungroup transformations

567-------------------------------------------------------------------------------

308-------------------------------------------------------------------------------

@@ -725,13 +466,9 @@ o_1_space_copy_read_group_ungroup env =

725allBenchmarks :: BenchEnv -> [Benchmark]

466allBenchmarks :: BenchEnv -> [Benchmark]

726allBenchmarks env = Prelude.concat

467allBenchmarks env = Prelude.concat

727 [ o_1_space_copy_chunked env

468 [ o_1_space_copy_chunked env

728− , o_1_space_copy_exceptions_readChunks env

729− , o_1_space_copy_exceptions_toChunks env

730 , o_1_space_copy_read env

469 , o_1_space_copy_read env

731 , o_1_space_copy_fromBytes env

470 , o_1_space_copy_fromBytes env

732 , o_1_space_copy env

471 , o_1_space_copy env

733− , o_1_space_copy_read_exceptions env

734− , o_1_space_copy_stream_exceptions env

735 , o_1_space_copy_toChunks_group_ungroup env

472 , o_1_space_copy_toChunks_group_ungroup env

736 , o_1_space_copy_read_group_ungroup env

473 , o_1_space_copy_read_group_ungroup env

737 ]

474 ]

benchmark/Streamly/Benchmark/Prelude/Serial.hs+6−2

@@ -17,10 +17,13 @@ import qualified Serial.Transformation1 as Transformation1

17import qualified Serial.Transformation2 as Transformation2

18import qualified Serial.Transformation3 as Transformation3

19import qualified Serial.Nested as Nested

20+import qualified Serial.Exceptions as Exceptions

21import Gauge

22import Gauge

22import Streamly.Benchmark.Common

23import Streamly.Benchmark.Common

25+import Streamly.Benchmark.CommonH

26+

24moduleName :: String

27moduleName :: String

25moduleName = "Prelude.Serial"

28moduleName = "Prelude.Serial"

@@ -34,8 +37,9 @@ moduleName = "Prelude.Serial"

34main :: IO ()

37main :: IO ()

35main = do

38main = do

36 (value, cfg, benches) <- parseCLIOpts defaultStreamSize

39 (value, cfg, benches) <- parseCLIOpts defaultStreamSize

40+ env <- mkBenchEnv "Benchmark_FileSystem_Handle_InputFile"

37− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)

41+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value <>

38−

42+ Exceptions.allBenchmarks env)

39 where

43 where

41 allBenchmarks size = Prelude.concat

45 allBenchmarks size = Prelude.concat

benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hsnew file+233

@@ -0,0 +1,233 @@

1+-- |

2+-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions

4+--

5+-- License : BSD3

6+-- Maintainer : streamly@composewell.com

7+-- Stability : experimental

8+-- Portability : GHC

10+{-# LANGUAGE CPP #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

12+

13+#ifdef __HADDOCK_VERSION__

14+#undef INSPECTION

15+#endif

16+

17+#ifdef INSPECTION

18+{-# LANGUAGE TemplateHaskell #-}

19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

20+#endif

21+

22+module Serial.Exceptions

23+ (allBenchmarks)

24+where

25+

26+import Control.Exception (SomeException)

27+import System.IO (Handle, hClose, hPutChar)

28+import Prelude hiding (last, length)

29+import Streamly.Internal.Data.Array.Storable.Foreign.Types (defaultChunkSize)

30+

31+import qualified Streamly.Data.Fold as FL

32+import qualified Streamly.Unicode.Stream as SS

33+import qualified Streamly.FileSystem.Handle as FH

34+import qualified Streamly.Internal.Data.Unfold as IUF

35+import qualified Streamly.Internal.Unicode.Stream as IUS

36+import qualified Streamly.Internal.FileSystem.Handle as IFH

37+import qualified Streamly.Internal.Memory.ArrayStream as AS

38+import qualified Streamly.Internal.Unicode.Array.Char as IUA

39+import qualified Streamly.Internal.Data.Stream.IsStream as IP

40+import qualified Streamly.Data.Array.Storable.Foreign as A

41+import qualified Streamly.Prelude as S

42+

43+import Gauge hiding (env)

44+-- import Handle.Common

45+import Streamly.Benchmark.CommonH

46+

47+#ifdef INSPECTION

48+import Foreign.Storable (Storable)

49+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))

50+

51+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D

52+import qualified Streamly.Internal.Data.Tuple.Strict as Strict

53+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

54+import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as AT

55+

56+import Test.Inspection

57+#endif

58+

59+-------------------------------------------------------------------------------

60+-- stream exceptions

61+-------------------------------------------------------------------------------

62+

63+-- | Send the file contents to /dev/null with exception handling

64+readWriteOnExceptionStream :: Handle -> Handle -> IO ()

65+readWriteOnExceptionStream inh devNull =

66+ let readEx = S.onException (hClose inh) (S.unfold FH.read inh)

67+ in S.fold (FH.write devNull) $ readEx

68+

69+-- | Send the file contents to /dev/null with exception handling

70+readWriteHandleExceptionStream :: Handle -> Handle -> IO ()

71+readWriteHandleExceptionStream inh devNull =

72+ let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)

73+ readEx = S.handle handler (S.unfold FH.read inh)

74+ in S.fold (FH.write devNull) $ readEx

75+

76+-- | Send the file contents to /dev/null with exception handling

77+readWriteFinally_Stream :: Handle -> Handle -> IO ()

78+readWriteFinally_Stream inh devNull =

79+ let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)

80+ in S.fold (FH.write devNull) readEx

81+

82+readWriteFinallyStream :: Handle -> Handle -> IO ()

83+readWriteFinallyStream inh devNull =

84+ let readEx = S.finally (hClose inh) (S.unfold FH.read inh)

85+ in S.fold (FH.write devNull) readEx

86+

87+-- | Send the file contents to /dev/null with exception handling

88+fromToBytesBracket_Stream :: Handle -> Handle -> IO ()

89+fromToBytesBracket_Stream inh devNull =

90+ let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)

91+ (\_ -> IFH.toBytes inh)

92+ in IFH.fromBytes devNull $ readEx

93+

94+#ifdef INSPECTION

95+inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream

96+-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step

97+#endif

98+

99+fromToBytesBracketStream :: Handle -> Handle -> IO ()

100+fromToBytesBracketStream inh devNull =

101+ let readEx = S.bracket (return ()) (\_ -> hClose inh)

102+ (\_ -> IFH.toBytes inh)

103+ in IFH.fromBytes devNull $ readEx

104+

105+readWriteBeforeAfterStream :: Handle -> Handle -> IO ()

106+readWriteBeforeAfterStream inh devNull =

107+ let readEx =

108+ IP.after (hClose inh)

109+ $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)

110+ in S.fold (FH.write devNull) readEx

111+

112+readWriteAfterStream :: Handle -> Handle -> IO ()

113+readWriteAfterStream inh devNull =

114+ let readEx = IP.after (hClose inh) (S.unfold FH.read inh)

115+ in S.fold (FH.write devNull) readEx

116+

117+readWriteAfter_Stream :: Handle -> Handle -> IO ()

118+readWriteAfter_Stream inh devNull =

119+ let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)

120+ in S.fold (FH.write devNull) readEx

121+

122+o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]

123+o_1_space_copy_stream_exceptions env =

124+ [ bgroup "copy/read/exceptions"

125+ [ mkBenchSmall "S.onException" env $ \inh _ ->

126+ readWriteOnExceptionStream inh (nullH env)

127+ , mkBenchSmall "S.handle" env $ \inh _ ->

128+ readWriteHandleExceptionStream inh (nullH env)

129+ , mkBenchSmall "S.finally_" env $ \inh _ ->

130+ readWriteFinally_Stream inh (nullH env)

131+ , mkBenchSmall "S.finally" env $ \inh _ ->

132+ readWriteFinallyStream inh (nullH env)

133+ , mkBenchSmall "S.after . S.before" env $ \inh _ ->

134+ readWriteBeforeAfterStream inh (nullH env)

135+ , mkBenchSmall "S.after" env $ \inh _ ->

136+ readWriteAfterStream inh (nullH env)

137+ , mkBenchSmall "S.after_" env $ \inh _ ->

138+ readWriteAfter_Stream inh (nullH env)

139+ ]

140+ , bgroup "copy/fromToBytes/exceptions"

141+ [ mkBenchSmall "S.bracket_" env $ \inh _ ->

142+ fromToBytesBracket_Stream inh (nullH env)

143+ , mkBenchSmall "S.bracket" env $ \inh _ ->

144+ fromToBytesBracketStream inh (nullH env)

145+ ]

146+ ]

147+

148+ -------------------------------------------------------------------------------

149+-- Exceptions readChunks

150+-------------------------------------------------------------------------------

151+

152+-- | Send the file contents to /dev/null with exception handling

153+readChunksOnException :: Handle -> Handle -> IO ()

154+readChunksOnException inh devNull =

155+ let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks

156+ in IUF.fold readEx (IFH.writeChunks devNull) inh

157+

158+#ifdef INSPECTION

159+inspect $ hasNoTypeClasses 'readChunksOnException

160+-- inspect $ 'readChunksOnException `hasNoType` ''Step

161+#endif

162+

163+-- | Send the file contents to /dev/null with exception handling

164+readChunksBracket_ :: Handle -> Handle -> IO ()

165+readChunksBracket_ inh devNull =

166+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks

167+ in IUF.fold readEx (IFH.writeChunks devNull) inh

168+

169+#ifdef INSPECTION

170+inspect $ hasNoTypeClasses 'readChunksBracket_

171+-- inspect $ 'readChunksBracket `hasNoType` ''Step

172+#endif

173+

174+readChunksBracket :: Handle -> Handle -> IO ()

175+readChunksBracket inh devNull =

176+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks

177+ in IUF.fold readEx (IFH.writeChunks devNull) inh

178+

179+o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]

180+o_1_space_copy_exceptions_readChunks env =

181+ [ bgroup "copy/readChunks/exceptions"

182+ [ mkBench "UF.onException" env $ \inH _ ->

183+ readChunksOnException inH (nullH env)

184+ , mkBench "UF.bracket_" env $ \inH _ ->

185+ readChunksBracket_ inH (nullH env)

186+ , mkBench "UF.bracket" env $ \inH _ ->

187+ readChunksBracket inH (nullH env)

188+ ]

189+ ]

190+

191+-------------------------------------------------------------------------------

192+-- Exceptions toChunks

193+-------------------------------------------------------------------------------

194+

195+-- | Send the file contents to /dev/null with exception handling

196+toChunksBracket_ :: Handle -> Handle -> IO ()

197+toChunksBracket_ inh devNull =

198+ let readEx = IP.bracket_

199+ (return ())

200+ (\_ -> hClose inh)

201+ (\_ -> IFH.toChunks inh)

202+ in S.fold (IFH.writeChunks devNull) $ readEx

203+

204+#ifdef INSPECTION

205+inspect $ hasNoTypeClasses 'toChunksBracket_

206+-- inspect $ 'toChunksBracket `hasNoType` ''Step

207+#endif

208+

209+toChunksBracket :: Handle -> Handle -> IO ()

210+toChunksBracket inh devNull =

211+ let readEx = S.bracket

212+ (return ())

213+ (\_ -> hClose inh)

214+ (\_ -> IFH.toChunks inh)

215+ in S.fold (IFH.writeChunks devNull) $ readEx

216+

217+o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]

218+o_1_space_copy_exceptions_toChunks env =

219+ [ bgroup "copy/toChunks/exceptions"

220+ [ mkBench "S.bracket_" env $ \inH _ ->

221+ toChunksBracket_ inH (nullH env)

222+ , mkBench "S.bracket" env $ \inH _ ->

223+ toChunksBracket inH (nullH env)

224+ ]

225+ ]

226+

227+

228+allBenchmarks :: BenchEnv -> [Benchmark]

229+allBenchmarks env = Prelude.concat

230+ [ o_1_space_copy_exceptions_readChunks env

231+ , o_1_space_copy_exceptions_toChunks env

232+ , o_1_space_copy_stream_exceptions env

233+ ]

benchmark/streamly-benchmarks.cabal+15−3

@@ -156,7 +156,7 @@ common bench-options-threaded

156benchmark Prelude.Serial

157 import: bench-options

158 type: exitcode-stdio-1.0

159− hs-source-dirs: Streamly/Benchmark/Prelude

159+ hs-source-dirs: . Streamly/Benchmark/Prelude

160 main-is: Serial.hs

161 other-modules:

162 Serial.Generation

@@ -165,10 +165,16 @@ benchmark Prelude.Serial

165 , Serial.Transformation2

166 , Serial.Transformation3

167 , Serial.Nested

168+ , Serial.Exceptions

169+ ,Streamly.Benchmark.CommonH

168 if impl(ghcjs)

170 if impl(ghcjs)

169 buildable: False

171 buildable: False

170 else

172 else

171 buildable: True

173 buildable: True

174+ build-depends:

175+ typed-process >= 0.2.3 && < 0.3

176+ , directory >= 1.2.2 && < 1.4

177+ , ghc-prim >= 0.4 && < 0.7

172

178

173benchmark Prelude.WSerial

179benchmark Prelude.WSerial

174 import: bench-options

180 import: bench-options

@@ -248,10 +254,15 @@ benchmark Data.Unfold

248 hs-source-dirs: .

254 hs-source-dirs: .

249 main-is: Streamly/Benchmark/Data/Unfold.hs

255 main-is: Streamly/Benchmark/Data/Unfold.hs

250 other-modules: Streamly.Benchmark.Data.NestedUnfoldOps

256 other-modules: Streamly.Benchmark.Data.NestedUnfoldOps

257+ ,Streamly.Benchmark.CommonH

251 if impl(ghcjs)

258 if impl(ghcjs)

252 buildable: False

259 buildable: False

253 else

260 else

254 buildable: True

261 buildable: True

262+ build-depends:

263+ typed-process >= 0.2.3 && < 0.3

264+ , directory >= 1.2.2 && < 1.4

265+ , ghc-prim >= 0.4 && < 0.7

255

266

256benchmark Data.Fold

267benchmark Data.Fold

257 import: bench-options

268 import: bench-options

@@ -438,12 +449,13 @@ benchmark FileSystem.Handle

438 import: bench-options

449 import: bench-options

439 type: exitcode-stdio-1.0

450 type: exitcode-stdio-1.0

440 ghc-options: +RTS -M3000M -RTS

451 ghc-options: +RTS -M3000M -RTS

441− hs-source-dirs: Streamly/Benchmark/FileSystem

452+ hs-source-dirs: . Streamly/Benchmark/FileSystem

442 main-is: Handle.hs

453 main-is: Handle.hs

443 other-modules:

454 other-modules:

444 Handle.Read

455 Handle.Read

445 , Handle.ReadWrite

456 , Handle.ReadWrite

446− , Handle.Common

457+ -- , Handle.Common

458+ , Streamly.Benchmark.CommonH

447 build-depends:

459 build-depends:

448 typed-process >= 0.2.3 && < 0.3

460 typed-process >= 0.2.3 && < 0.3

449 , directory >= 1.2.2 && < 1.4

461 , directory >= 1.2.2 && < 1.4