Skip to content

Commit efebb6b

Browse files
adithyaovadithyaov
committed
Add benchmarks and tests for the DirIO module
1 parent 4b443ac commit efebb6b

18 files changed

+505
-0
lines changed

‎.packcheck.ignore‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,3 +35,6 @@ targets/default.nix
3535
targets/cabal.project
3636
test/test-runner/default.nix
3737
test/test-runner/cabal.project
38+
bench-test-lib/create_dir_structure.sh
39+
bench-test-lib/bench-test-lib.cabal
40+
bench-test-lib/src/BenchTestLib/DirIO.hs

‎bench-test-lib/bench-test-lib.cabal‎

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,67 @@
1+
cabal-version: 3.0
2+
name: bench-test-lib
3+
version: 0.1.0.0
4+
build-type: Simple
5+
6+
common compile-options
7+
default-language: Haskell2010
8+
ghc-options: -Weverything
9+
-Wno-implicit-prelude
10+
-Wno-missing-deriving-strategies
11+
-Wno-missing-exported-signatures
12+
-Wno-missing-import-lists
13+
-Wno-missing-local-signatures
14+
-Wno-missing-safe-haskell-mode
15+
-Wno-missed-specialisations
16+
-Wno-all-missed-specialisations
17+
-Wno-monomorphism-restriction
18+
-Wno-prepositive-qualified-module
19+
-Wno-unsafe
20+
-Rghc-timing
21+
22+
if impl(ghc >= 9.2)
23+
ghc-options:
24+
-Wno-missing-kind-signatures
25+
-Wno-redundant-bang-patterns
26+
-Wno-operator-whitespace
27+
28+
if impl(ghc >= 9.8)
29+
ghc-options:
30+
-Wno-missing-role-annotations
31+
32+
common default-extensions
33+
default-extensions:
34+
BangPatterns
35+
ConstraintKinds
36+
DeriveDataTypeable
37+
DeriveGeneric
38+
DeriveTraversable
39+
ExistentialQuantification
40+
FlexibleContexts
41+
FlexibleInstances
42+
GeneralizedNewtypeDeriving
43+
InstanceSigs
44+
KindSignatures
45+
MultiParamTypeClasses
46+
RankNTypes
47+
ScopedTypeVariables
48+
TupleSections
49+
TypeApplications
50+
TypeOperators
51+
52+
-- Not GHC2021
53+
CApiFFI
54+
CPP
55+
LambdaCase
56+
MagicHash
57+
RecordWildCards
58+
59+
library
60+
import: compile-options, default-extensions
61+
exposed-modules: BenchTestLib.DirIO
62+
build-depends: base
63+
, streamly-core
64+
, streamly
65+
, process
66+
hs-source-dirs: src
67+
default-language: Haskell2010

‎bench-test-lib/create_dir_structure.sh‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
#!/bin/bash
2+
3+
# Function to create directory structure
4+
create_structure() {
5+
local parent_dir=$1
6+
local depth=$2
7+
local width=$3
8+
9+
# Stop if depth reaches zero
10+
if [ "$depth" -le 0 ]; then
11+
return
12+
fi
13+
14+
# Create subdirectories
15+
for i in $(seq 1 "$width"); do
16+
sub_dir="${parent_dir}/dir_$i"
17+
mkdir -p "$sub_dir"
18+
19+
# Recursively create deeper levels
20+
create_structure "$sub_dir" $((depth - 1)) "$width"
21+
done
22+
}
23+
24+
# Usage check
25+
if [ "$#" -ne 3 ]; then
26+
echo "Usage: $0 <root_directory> <depth> <width>"
27+
exit 1
28+
fi
29+
30+
# Get parameters
31+
ROOT_DIR=$1
32+
DEPTH=$2
33+
WIDTH=$3
34+
35+
# Ensure the root directory exists
36+
mkdir -p "$ROOT_DIR"
37+
echo "Root directory: $ROOT_DIR"
38+
39+
# Start creating the directory structure
40+
create_structure "$ROOT_DIR" "$DEPTH" "$WIDTH"
41+
42+
echo "Directory structure creation completed."

‎bench-test-lib/src/BenchTestLib/DirIO.hs‎

Lines changed: 177 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,177 @@
1+
-- |
2+
-- Module : BenchTestLib.DirIO
3+
-- Copyright : (c) 2019 Composewell Technologies
4+
-- License : BSD-3-Clause
5+
-- Maintainer : streamly@composewell.com
6+
-- Stability : experimental
7+
-- Portability : GHC
8+
9+
module BenchTestLib.DirIO
10+
( createDirStucture
11+
, listDirUnfoldDfs
12+
, listDirUnfoldBfs
13+
, listDirUnfoldBfsRev
14+
, listDirConcatDfs
15+
, listDirConcatBfs
16+
, listDirConcatBfsRev
17+
, listDirAppend
18+
, listDirInterleave
19+
, listDirPar
20+
, listDirParInterleaved
21+
, listDirParOrdered
22+
, listDirChunkDfs
23+
, listDirChunkBfs
24+
, listDirChunkBfsRev
25+
, listDirChunkAppend
26+
, listDirChunkInterleave
27+
, listDirChunkPar
28+
, listDirChunkParInterleaved
29+
, listDirChunkParOrdered
30+
, listDirByteChunked
31+
) where
32+
33+
--------------------------------------------------------------------------------
34+
-- Imports
35+
--------------------------------------------------------------------------------
36+
37+
import Data.Maybe (fromJust)
38+
import Data.Word (Word8)
39+
import Streamly.Data.Array (Array)
40+
import Streamly.Data.Stream (Stream)
41+
import Streamly.Data.Unfold (Unfold)
42+
import Streamly.FileSystem.Path (Path)
43+
import System.Process (callCommand)
44+
45+
import qualified Streamly.Data.Stream.Prelude as Stream
46+
import qualified Streamly.Data.Array as Array
47+
import qualified Streamly.Internal.Data.Stream as Stream
48+
import qualified Streamly.Data.StreamK as StreamK
49+
import qualified Streamly.Internal.Data.StreamK as StreamK
50+
import qualified Streamly.Data.Unfold as Unfold
51+
import qualified Streamly.Internal.Data.Unfold as Unfold
52+
import qualified Streamly.Internal.FileSystem.DirIO as Dir
53+
import qualified Streamly.FileSystem.Path as Path
54+
import qualified Streamly.Internal.FileSystem.Path as Path (toChunk)
55+
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
56+
import qualified Streamly.Internal.FileSystem.Posix.ReadDir as Dir
57+
#endif
58+
59+
--------------------------------------------------------------------------------
60+
-- Helpers
61+
--------------------------------------------------------------------------------
62+
63+
concatIterateWith :: Monad m =>
64+
(a -> Stream m a)
65+
-> (StreamK.StreamK m a
66+
-> StreamK.StreamK m a -> StreamK.StreamK m a)
67+
-> Stream m a
68+
-> Stream m a
69+
concatIterateWith nxt f =
70+
StreamK.toStream
71+
. StreamK.concatIterateWith f (StreamK.fromStream . nxt)
72+
. StreamK.fromStream
73+
74+
mergeIterateWith :: Monad m =>
75+
(a -> Stream m a)
76+
-> (StreamK.StreamK m a
77+
-> StreamK.StreamK m a -> StreamK.StreamK m a)
78+
-> Stream m a
79+
-> Stream m a
80+
mergeIterateWith nxt f =
81+
StreamK.toStream
82+
. StreamK.mergeIterateWith f (StreamK.fromStream . nxt)
83+
. StreamK.fromStream
84+
85+
streamDir :: Either Path b -> Stream IO (Either Path Path)
86+
streamDir = either Dir.readEitherPaths (const Stream.nil)
87+
88+
unfoldDir :: Unfold IO (Either Path b) (Either Path Path)
89+
unfoldDir = Unfold.either Dir.eitherReaderPaths Unfold.nil
90+
91+
streamDirMaybe :: Either Path b -> Maybe (Stream IO (Either Path Path))
92+
streamDirMaybe = either (Just . Dir.readEitherPaths) (const Nothing)
93+
94+
_streamDirByteChunked
95+
:: Either [Path] b -> Stream IO (Either [Path] (Array Word8))
96+
_streamDirByteChunked = either Dir.readEitherByteChunks (const Stream.nil)
97+
98+
streamDirByteChunkedMaybe
99+
:: Either [Path] b -> Maybe (Stream IO (Either [Path] (Array Word8)))
100+
streamDirByteChunkedMaybe =
101+
either (Just . Dir.readEitherByteChunks) (const Nothing)
102+
103+
streamDirChunkedMaybe :: Either [Path] b -> Maybe (Stream IO (Either [Path] [Path]))
104+
streamDirChunkedMaybe = either (Just . Dir.readEitherChunks) (const Nothing)
105+
106+
streamDirChunked :: Either [Path] b -> Stream IO (Either [Path] [Path])
107+
streamDirChunked = either Dir.readEitherChunks (const Stream.nil)
108+
109+
--------------------------------------------------------------------------------
110+
-- Functions
111+
--------------------------------------------------------------------------------
112+
113+
createDirStucture :: FilePath -> IO ()
114+
createDirStucture dirRoot = do
115+
let cmd =
116+
"bench-test-lib/create_dir_structure.sh " ++ dirRoot ++ " 5 5"
117+
callCommand ("mkdir -p " ++ dirRoot)
118+
callCommand cmd
119+
120+
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
121+
-- Fastest implementation, only works for posix as of now.
122+
listDirByteChunked :: FilePath -> Stream IO (Array Word8)
123+
listDirByteChunked inp = do
124+
Stream.catRights
125+
$ Stream.concatIterateDfs streamDirByteChunkedMaybe
126+
$ Stream.fromPure (Left [fromJust $ Path.fromString inp])
127+
#endif
128+
129+
-- Faster than the listDir implementation below
130+
listDirChunkedWith
131+
:: (Stream IO (Either [Path] b) -> Stream IO (Either [Path] [Path]))
132+
-> [Char] -> Stream IO Word8
133+
listDirChunkedWith act inp = do
134+
Stream.unfoldEachEndBy 10 Array.reader
135+
$ fmap Path.toChunk
136+
$ Stream.unfoldEach Unfold.fromList
137+
$ fmap (either id id)
138+
$ act
139+
$ Stream.fromPure (Left [fromJust $ Path.fromString inp])
140+
141+
listDirWith
142+
:: (Stream IO (Either Path Path) -> Stream IO (Either Path Path))
143+
-> [Char] -> Stream IO Word8
144+
listDirWith act inp = do
145+
Stream.unfoldEachEndBy 10 Array.reader
146+
$ fmap (Path.toChunk . either id id)
147+
$ act
148+
$ Stream.fromPure (Left (fromJust $ Path.fromString inp))
149+
150+
#define DEF_LIST_DIR(x,y); \
151+
x :: [Char] -> Stream IO Word8;\
152+
x = listDirWith (y)
153+
154+
DEF_LIST_DIR(listDirUnfoldDfs, Stream.unfoldIterateDfs unfoldDir)
155+
DEF_LIST_DIR(listDirUnfoldBfs, Stream.unfoldIterateBfs unfoldDir)
156+
DEF_LIST_DIR(listDirUnfoldBfsRev, Stream.unfoldIterateBfsRev unfoldDir)
157+
DEF_LIST_DIR(listDirConcatDfs, Stream.concatIterateDfs streamDirMaybe)
158+
DEF_LIST_DIR(listDirConcatBfs, Stream.concatIterateBfs streamDirMaybe)
159+
DEF_LIST_DIR(listDirConcatBfsRev, Stream.concatIterateBfsRev streamDirMaybe)
160+
DEF_LIST_DIR(listDirAppend, concatIterateWith streamDir StreamK.append)
161+
DEF_LIST_DIR(listDirInterleave, mergeIterateWith streamDir StreamK.interleave)
162+
DEF_LIST_DIR(listDirPar, Stream.parConcatIterate id streamDir)
163+
DEF_LIST_DIR(listDirParInterleaved, Stream.parConcatIterate (Stream.interleaved True) streamDir)
164+
DEF_LIST_DIR(listDirParOrdered, Stream.parConcatIterate (Stream.ordered True) streamDir)
165+
166+
#define DEF_LIST_DIR_CHUNKED(x,y); \
167+
x :: [Char] -> Stream IO Word8;\
168+
x = listDirChunkedWith (y)
169+
170+
DEF_LIST_DIR_CHUNKED(listDirChunkDfs, Stream.concatIterateDfs streamDirChunkedMaybe)
171+
DEF_LIST_DIR_CHUNKED(listDirChunkBfs, Stream.concatIterateBfs streamDirChunkedMaybe)
172+
DEF_LIST_DIR_CHUNKED(listDirChunkBfsRev, Stream.concatIterateBfsRev streamDirChunkedMaybe)
173+
DEF_LIST_DIR_CHUNKED(listDirChunkAppend, concatIterateWith streamDirChunked StreamK.append)
174+
DEF_LIST_DIR_CHUNKED(listDirChunkInterleave, mergeIterateWith streamDirChunked StreamK.interleave)
175+
DEF_LIST_DIR_CHUNKED(listDirChunkPar, Stream.parConcatIterate id streamDirChunked)
176+
DEF_LIST_DIR_CHUNKED(listDirChunkParInterleaved, Stream.parConcatIterate (Stream.interleaved True) streamDirChunked)
177+
DEF_LIST_DIR_CHUNKED(listDirChunkParOrdered, Stream.parConcatIterate (Stream.ordered True) streamDirChunked)

‎benchmark/Streamly/Benchmark/FileSystem/DirIO.hs‎

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
-- |
2+
-- Module : Streamly.Benchmark.FileSystem.DirIO
3+
-- Copyright : (c) 2019 Composewell Technologies
4+
-- License : BSD-3-Clause
5+
-- Maintainer : streamly@composewell.com
6+
-- Stability : experimental
7+
-- Portability : GHC
8+
9+
{-# LANGUAGE CPP #-}
10+
{-# LANGUAGE QuasiQuotes #-}
11+
12+
module Main (main) where
13+
14+
--------------------------------------------------------------------------------
15+
-- Imports
16+
--------------------------------------------------------------------------------
17+
18+
import GHC.IO.Encoding (setLocaleEncoding, utf8)
19+
import Streamly.Benchmark.Common (o_1_space_prefix)
20+
21+
import qualified Streamly.Data.Stream.Prelude as Stream
22+
import qualified Streamly.Data.Fold as Fold
23+
24+
import Prelude hiding (last, length)
25+
import Test.Tasty.Bench
26+
import BenchTestLib.DirIO
27+
28+
--------------------------------------------------------------------------------
29+
-- Main
30+
--------------------------------------------------------------------------------
31+
32+
moduleName :: String
33+
moduleName = "FileSystem.DirIO"
34+
35+
#define BENCH(x) \
36+
bench " x " $ nfIO $ \
37+
Stream.fold Fold.drain $ x dirRoot
38+
39+
-- | List the current directory recursively
40+
main :: IO ()
41+
main = do
42+
setLocaleEncoding utf8
43+
44+
let dirRoot = "benchmark-tmp/dir-structure"
45+
createDirStucture dirRoot
46+
47+
defaultMain
48+
[ bgroup (o_1_space_prefix moduleName)
49+
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
50+
$ (bench "listDirByteChunked" $ nfIO $
51+
Stream.fold Fold.drain $ listDirByteChunked dirRoot) :
52+
#endif
53+
[ BENCH(listDirUnfoldDfs)
54+
-- NOTE: The BFS traversal fails with:
55+
-- openDirStream: resource exhausted (Too many open files)
56+
, BENCH(listDirUnfoldDfs)
57+
-- , BENCH(listDirUnfoldBfs)
58+
-- , BENCH(listDirUnfoldBfsRev)
59+
, BENCH(listDirConcatDfs)
60+
-- , BENCH(listDirConcatBfs)
61+
-- , BENCH(listDirConcatBfsRev)
62+
, BENCH(listDirAppend)
63+
, BENCH(listDirInterleave)
64+
, BENCH(listDirPar)
65+
, BENCH(listDirParInterleaved)
66+
, BENCH(listDirParOrdered)
67+
, BENCH(listDirChunkDfs)
68+
-- , BENCH(listDirChunkBfs)
69+
-- , BENCH(listDirChunkBfsRev)
70+
, BENCH(listDirChunkAppend)
71+
, BENCH(listDirChunkInterleave)
72+
, BENCH(listDirChunkPar)
73+
, BENCH(listDirChunkParInterleaved)
74+
, BENCH(listDirChunkParOrdered)
75+
]
76+
]

‎benchmark/streamly-benchmarks.cabal‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -193,6 +193,7 @@ common bench-depends
193193
, tasty-bench >= 0.3 && < 0.5
194194
, tasty >= 1.4.1 && < 1.6
195195
, streamly-core
196+
, bench-test-lib
196197

197198
if !flag(use-streamly-core)
198199
build-depends: streamly
@@ -593,6 +594,16 @@ benchmark FileSystem.Handle
593594
else
594595
buildable: True
595596

597+
benchmark FileSystem.DirIO
598+
import: bench-options
599+
type: exitcode-stdio-1.0
600+
hs-source-dirs: Streamly/Benchmark/FileSystem
601+
main-is: DirIO.hs
602+
if flag(use-streamly-core)
603+
buildable: False
604+
else
605+
buildable: True
606+
596607
benchmark Unicode.Char
597608
import: bench-options
598609
type: exitcode-stdio-1.0

0 commit comments

Comments
 (0)