mirror of
https://github.com/composewell/streamly.git
synced 2024-09-11 11:37:22 +03:00
Refactor, cleanup, hlint - fold and handle tests
This commit is contained in:
parent
0bd1586175
commit
c3b506b68b
@ -26,7 +26,6 @@ test/Streamly/Test/Data/Array.hs
|
||||
test/Streamly/Test/Data/Array/Prim.hs
|
||||
test/Streamly/Test/Data/Array/Prim/Pinned.hs
|
||||
test/Streamly/Test/Data/Array/Storable/Foreign.hs
|
||||
test/Streamly/Test/Data/Fold.hs
|
||||
test/Streamly/Test/Data/Parser.hs
|
||||
test/Streamly/Test/Data/Parser/ParserD.hs
|
||||
test/Streamly/Test/Data/SmallArray.hs
|
||||
|
@ -105,6 +105,6 @@ GROUP_TARGETS="\
|
||||
INDIVIDUAL_TARGETS="\
|
||||
Data.Unfold \
|
||||
Unicode.Stream \
|
||||
`bench_only FileSystem.Handle` \
|
||||
FileSystem.Handle \
|
||||
`test_only FileSystem.Event` \
|
||||
`test_only version-bounds`"
|
||||
|
2
hie.yaml
2
hie.yaml
@ -80,6 +80,8 @@ cradle:
|
||||
component: "test:Unicode.Stream"
|
||||
- path: "./test/Streamly/Test/FileSystem/Event.hs"
|
||||
component: "test:FileSystem.Event"
|
||||
- path: "./test/Streamly/Test/FileSystem/Handle.hs"
|
||||
component: "test:FileSystem.Handle"
|
||||
- path: "./test/version-bounds.hs"
|
||||
component: "test:version-bounds"
|
||||
|
||||
|
@ -219,13 +219,13 @@ main =
|
||||
prop "toStreamRev . writeN === reverse" testFoldNToStreamRev
|
||||
prop "read . fromStreamN === id" testFromStreamNUnfold
|
||||
prop "toStream . fromStreamN === id" testFromStreamNToStream
|
||||
prop "First N elements of a list" testFromListN
|
||||
prop "fromListN" testFromListN
|
||||
|
||||
#ifndef TEST_SMALL_ARRAY
|
||||
prop "length . fromStream === n" testLengthFromStream
|
||||
prop "toStream . fromStream === id" testFromStreamToStream
|
||||
prop "read . write === id" testFoldUnfold
|
||||
prop "From a list" testFromList
|
||||
prop "fromList" testFromList
|
||||
#endif
|
||||
|
||||
#if defined(TEST_ARRAY) ||\
|
||||
|
@ -1,8 +1,7 @@
|
||||
module Main (main) where
|
||||
|
||||
import Prelude hiding
|
||||
(maximum, minimum, elem, notElem, null, product, sum, head, last)
|
||||
import Data.Semigroup (Sum(..), getSum)
|
||||
import Streamly.Test.Common (checkListEqual)
|
||||
import Test.QuickCheck
|
||||
( Gen
|
||||
, Property
|
||||
@ -15,15 +14,15 @@ import Test.QuickCheck
|
||||
, vectorOf
|
||||
, withMaxSuccess
|
||||
)
|
||||
import Prelude hiding
|
||||
(maximum, minimum, elem, notElem, null, product, sum, head, last)
|
||||
import Streamly.Test.Common (checkListEqual)
|
||||
import Test.QuickCheck.Monadic (monadicIO, assert, run)
|
||||
|
||||
import qualified Prelude
|
||||
import qualified Streamly.Internal.Data.Fold as F
|
||||
import qualified Streamly.Prelude as S
|
||||
import qualified Streamly.Data.Fold as FL
|
||||
|
||||
import Prelude hiding
|
||||
(maximum, minimum, elem, notElem, null, product, sum, head, last)
|
||||
import Test.Hspec as H
|
||||
import Test.Hspec.QuickCheck
|
||||
|
||||
@ -70,10 +69,11 @@ length :: [Int] -> Expectation
|
||||
length ls = S.fold FL.length (S.fromList ls) `shouldReturn` Prelude.length ls
|
||||
|
||||
sum :: [Int] -> Expectation
|
||||
sum ls = S.fold FL.sum (S.fromList ls) `shouldReturn` foldl (+) 0 ls
|
||||
sum ls = S.fold FL.sum (S.fromList ls) `shouldReturn` Prelude.sum ls
|
||||
|
||||
product :: [Int] -> Expectation
|
||||
product ls = S.fold FL.product (S.fromList ls) `shouldReturn` foldl (*) 1 ls
|
||||
product ls =
|
||||
S.fold FL.product (S.fromList ls) `shouldReturn` Prelude.product ls
|
||||
|
||||
lesser :: (a -> a -> Ordering) -> a -> a -> a
|
||||
lesser f x y = if f x y == LT then x else y
|
||||
@ -90,8 +90,7 @@ foldMaybe f acc ls =
|
||||
maximumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation
|
||||
maximumBy genmin f ls =
|
||||
S.fold (FL.maximumBy f) (S.fromList ls)
|
||||
`shouldReturn`
|
||||
foldMaybe (greater f) genmin ls
|
||||
`shouldReturn` foldMaybe (greater f) genmin ls
|
||||
|
||||
maximum :: (Show a, Ord a) => a -> [a] -> Expectation
|
||||
maximum genmin ls =
|
||||
@ -129,16 +128,16 @@ mapMaybe ls =
|
||||
in S.fold f (S.fromList ls) `shouldReturn` filter even ls
|
||||
|
||||
nth :: Int -> [a] -> Maybe a
|
||||
nth idx (x:xs) = if idx == 0
|
||||
then Just x
|
||||
else if idx < 0
|
||||
then Nothing
|
||||
else nth (idx - 1) xs
|
||||
nth idx (x : xs)
|
||||
| idx == 0 = Just x
|
||||
| idx < 0 = Nothing
|
||||
| otherwise = nth (idx - 1) xs
|
||||
nth _ [] = Nothing
|
||||
|
||||
index :: Int -> [String] -> Expectation
|
||||
index idx ls = let x = S.fold (FL.index idx) (S.fromList ls)
|
||||
in x `shouldReturn` (nth idx ls)
|
||||
index idx ls =
|
||||
let x = S.fold (FL.index idx) (S.fromList ls)
|
||||
in x `shouldReturn` nth idx ls
|
||||
|
||||
find :: (Show a, Eq a) => (a -> Bool) -> [a] -> Expectation
|
||||
find f ls = do
|
||||
@ -152,7 +151,7 @@ find f ls = do
|
||||
in fld `shouldReturn` False
|
||||
|
||||
neg :: (a -> Bool) -> a -> Bool
|
||||
neg f x = if f x == True then False else True
|
||||
neg f x = not (f x)
|
||||
|
||||
findIndex :: (a -> Bool) -> [a] -> Expectation
|
||||
findIndex f ls = do
|
||||
@ -161,16 +160,16 @@ findIndex f ls = do
|
||||
Nothing ->
|
||||
let fld = S.fold (FL.all $ neg f) (S.fromList ls)
|
||||
in fld `shouldReturn` True
|
||||
Just idx -> if idx == 0
|
||||
then
|
||||
S.fold (FL.all f) (S.fromList []) `shouldReturn` True
|
||||
else
|
||||
S.fold (FL.all f) (S.fromList $ (take idx ls))
|
||||
`shouldReturn`
|
||||
False
|
||||
Just idx ->
|
||||
if idx == 0
|
||||
then
|
||||
S.fold (FL.all f) (S.fromList []) `shouldReturn` True
|
||||
else
|
||||
S.fold (FL.all f) (S.fromList $ take idx ls)
|
||||
`shouldReturn` False
|
||||
|
||||
predicate :: Int -> Bool
|
||||
predicate x = if x * x < 100 then True else False
|
||||
predicate x = x * x < 100
|
||||
|
||||
elemIndex :: Int -> [Int] -> Expectation
|
||||
elemIndex elm ls = do
|
||||
@ -180,13 +179,17 @@ elemIndex elm ls = do
|
||||
let fld = S.fold (FL.any (== elm)) (S.fromList ls)
|
||||
in fld `shouldReturn` False
|
||||
Just idx ->
|
||||
let fld = S.fold (FL.any (== elm)) (S.fromList $ (take idx ls))
|
||||
let fld = S.fold (FL.any (== elm)) (S.fromList $ take idx ls)
|
||||
in fld `shouldReturn` False
|
||||
|
||||
null :: [Int] -> Expectation
|
||||
null ls = S.fold FL.null (S.fromList ls) `shouldReturn` case ls of
|
||||
[] -> True
|
||||
_ -> False
|
||||
null ls =
|
||||
S.fold FL.null (S.fromList ls)
|
||||
`shouldReturn`
|
||||
case ls of
|
||||
[] -> True
|
||||
_ -> False
|
||||
|
||||
elem :: Int -> [Int] -> Expectation
|
||||
elem elm ls = do
|
||||
y <- S.fold (FL.elem elm) (S.fromList ls)
|
||||
@ -201,7 +204,7 @@ notElem elm ls = do
|
||||
|
||||
all :: (a -> Bool) -> [a] -> Expectation
|
||||
all f ls =
|
||||
S.fold (FL.all f) (S.fromList ls) `shouldReturn` Prelude.and (map f ls)
|
||||
S.fold (FL.all f) (S.fromList ls) `shouldReturn` Prelude.all f ls
|
||||
|
||||
any :: (a -> Bool) -> [a] -> Expectation
|
||||
any f ls = S.fold (FL.any f) (S.fromList ls) `shouldReturn` Prelude.any f ls
|
||||
@ -257,7 +260,7 @@ mean =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold FL.mean (S.fromList ls)
|
||||
let v2 = (foldl (+) 0 ls) / fromIntegral (Prelude.length ls)
|
||||
let v2 = Prelude.sum ls / fromIntegral (Prelude.length ls)
|
||||
assert (abs (v1 - v2) < 0.0001)
|
||||
|
||||
stdDev :: Property
|
||||
@ -269,8 +272,8 @@ stdDev =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold FL.stdDev (S.fromList ls)
|
||||
let avg = (foldl (+) 0 ls) / fromIntegral (Prelude.length ls)
|
||||
se = (foldl (+) 0 (map (\x -> (x - avg) * (x - avg)) ls))
|
||||
let avg = Prelude.sum ls / fromIntegral (Prelude.length ls)
|
||||
se = Prelude.sum (fmap (\x -> (x - avg) * (x - avg)) ls)
|
||||
sd = sqrt $ se / fromIntegral (Prelude.length ls)
|
||||
assert (abs (v1 - sd) < 0.0001 )
|
||||
|
||||
@ -283,8 +286,8 @@ variance =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold FL.variance (S.fromList ls)
|
||||
let avg = (foldl (+) 0 ls) / fromIntegral (Prelude.length ls)
|
||||
se = (foldl (+) 0 (map (\x -> (x - avg) * (x - avg)) ls))
|
||||
let avg = Prelude.sum ls / fromIntegral (Prelude.length ls)
|
||||
se = Prelude.sum (fmap (\x -> (x - avg) * (x - avg)) ls)
|
||||
vr = se / fromIntegral (Prelude.length ls)
|
||||
assert (abs (v1 - vr) < 0.01 )
|
||||
|
||||
@ -297,7 +300,7 @@ mconcat =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold FL.mconcat (S.map Sum $ S.fromList ls)
|
||||
let v2 = (foldl (+) 0 ls)
|
||||
let v2 = Prelude.sum ls
|
||||
assert (getSum v1 == v2)
|
||||
|
||||
foldMap :: Property
|
||||
@ -309,7 +312,7 @@ foldMap =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold (FL.foldMap Sum) $ S.fromList ls
|
||||
let v2 = (foldl (+) 0 ls)
|
||||
let v2 = Prelude.sum ls
|
||||
assert (getSum v1 == v2)
|
||||
|
||||
foldMapM :: Property
|
||||
@ -321,7 +324,7 @@ foldMapM =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold (FL.foldMapM (return . Sum)) $ S.fromList ls
|
||||
let v2 = (foldl (+) 0 ls)
|
||||
let v2 = Prelude.sum ls
|
||||
assert (getSum v1 == v2)
|
||||
|
||||
lookup :: Property
|
||||
@ -363,7 +366,7 @@ teeWithLength =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold (FL.tee FL.sum FL.length) $ S.fromList ls
|
||||
let v2 = foldl (+) 0 ls
|
||||
let v2 = Prelude.sum ls
|
||||
v3 = Prelude.length ls
|
||||
assert (v1 == (v2, v3))
|
||||
|
||||
@ -376,7 +379,7 @@ teeWithMax =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold (FL.tee FL.sum FL.maximum) $ S.fromList ls
|
||||
let v2 = foldl (+) 0 ls
|
||||
let v2 = Prelude.sum ls
|
||||
v3 = foldMaybe (greater compare) intMin ls
|
||||
assert (v1 == (v2, v3))
|
||||
|
||||
@ -389,7 +392,7 @@ distribute =
|
||||
|
||||
action ls = do
|
||||
v1 <- run $ S.fold (FL.distribute [FL.sum, FL.length]) $ S.fromList ls
|
||||
let v2 = foldl (+) 0 ls
|
||||
let v2 = Prelude.sum ls
|
||||
v3 = Prelude.length ls
|
||||
assert (v1 == [v2, v3])
|
||||
|
||||
@ -418,7 +421,7 @@ main :: IO ()
|
||||
main = hspec $
|
||||
describe "Fold s" $ do
|
||||
prop "RollingHashFirstN" rollingHashFirstN
|
||||
prop "Index" $ index
|
||||
prop "Index" index
|
||||
prop "Head" head
|
||||
prop "Last" last
|
||||
prop "Length" Main.length
|
||||
|
@ -26,15 +26,15 @@ import System.IO.Temp (withSystemTempDirectory)
|
||||
import Test.QuickCheck (Property, forAll, Gen, vectorOf, choose)
|
||||
import Test.QuickCheck.Monadic (monadicIO, assert, run)
|
||||
|
||||
import Streamly.FileSystem.Handle as FH
|
||||
import qualified Streamly.Data.Fold as Fold
|
||||
import qualified Streamly.FileSystem.Handle as Handle
|
||||
import qualified Streamly.Internal.Data.Stream.IsStream as Stream
|
||||
import qualified Streamly.Internal.Data.Array.Storable.Foreign as Array
|
||||
import qualified Streamly.Internal.Unicode.Stream as Unicode
|
||||
|
||||
import Test.Hspec as H
|
||||
import Test.Hspec.QuickCheck
|
||||
|
||||
import qualified Streamly.Data.Fold as FL
|
||||
import qualified Streamly.Internal.Data.Stream.IsStream as S
|
||||
import qualified Streamly.Internal.Data.Array.Storable.Foreign as A
|
||||
import qualified Streamly.Internal.Unicode.Stream as U
|
||||
|
||||
allocOverhead :: Int
|
||||
allocOverhead = 2 * sizeOf (undefined :: Int)
|
||||
|
||||
@ -51,8 +51,9 @@ maxTestCount = 10
|
||||
chooseWord8 :: (Word8, Word8) -> Gen Word8
|
||||
chooseWord8 = choose
|
||||
|
||||
utf8ToString :: A.Array Word8 -> String
|
||||
utf8ToString = runIdentity . S.toList . U.decodeUtf8' . A.toStream
|
||||
utf8ToString :: Array.Array Word8 -> String
|
||||
utf8ToString =
|
||||
runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.toStream
|
||||
|
||||
testData :: String
|
||||
testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"
|
||||
@ -60,7 +61,7 @@ testData = "This is the test data for FileSystem.Handle ??`!@#$%^&*~~))`]"
|
||||
testDataLarge :: String
|
||||
testDataLarge = concat $ replicate 6000 testData
|
||||
|
||||
executor :: (Handle -> (SerialT IO Char)) -> IO (SerialT IO Char)
|
||||
executor :: (Handle -> SerialT IO Char) -> IO (SerialT IO Char)
|
||||
executor f =
|
||||
withSystemTempDirectory "fs_handle" $ \fp -> do
|
||||
let fpath = fp </> "tmp_read.txt"
|
||||
@ -70,38 +71,40 @@ executor f =
|
||||
|
||||
readFromHandle :: IO (SerialT IO Char)
|
||||
readFromHandle =
|
||||
let f = U.decodeUtf8 . S.unfold FH.read
|
||||
let f = Unicode.decodeUtf8 . Stream.unfold Handle.read
|
||||
in executor f
|
||||
|
||||
readWithBufferFromHandle :: IO (SerialT IO Char)
|
||||
readWithBufferFromHandle =
|
||||
let f1 = (\h -> (1024, h))
|
||||
f2 = U.decodeUtf8 . S.unfold FH.readWithBufferOf . f1
|
||||
f2 = Unicode.decodeUtf8 . Stream.unfold Handle.readWithBufferOf . f1
|
||||
in executor f2
|
||||
|
||||
readChunksFromHandle :: IO (SerialT IO Char)
|
||||
readChunksFromHandle =
|
||||
let f = U.decodeUtf8 . S.concatMap (A.toStream) . S.unfold FH.readChunks
|
||||
let f = Unicode.decodeUtf8
|
||||
. Stream.concatMap Array.toStream
|
||||
. Stream.unfold Handle.readChunks
|
||||
in executor f
|
||||
|
||||
readChunksWithBuffer :: IO (SerialT IO Char)
|
||||
readChunksWithBuffer =
|
||||
let f1 = (\h -> (1024, h))
|
||||
f2 =
|
||||
U.decodeUtf8
|
||||
. S.concatMap (A.toStream)
|
||||
. S.unfold FH.readChunksWithBufferOf
|
||||
Unicode.decodeUtf8
|
||||
. Stream.concatMap Array.toStream
|
||||
. Stream.unfold Handle.readChunksWithBufferOf
|
||||
. f1
|
||||
in executor f2
|
||||
|
||||
testRead :: (IsStream t) => IO (t IO Char) -> Property
|
||||
testRead fn = monadicIO $ do
|
||||
let v2 = (S.fromList testDataLarge)
|
||||
v1 <- run $ fn
|
||||
res <- run $ S.eqBy (==) v1 v2
|
||||
assert (res)
|
||||
let v2 = Stream.fromList testDataLarge
|
||||
v1 <- run fn
|
||||
res <- run $ Stream.eqBy (==) v1 v2
|
||||
assert res
|
||||
|
||||
testWrite :: (Handle -> FL.Fold IO Word8 ()) -> Property
|
||||
testWrite :: (Handle -> Fold.Fold IO Word8 ()) -> Property
|
||||
testWrite hfold =
|
||||
forAll (choose (0, maxArrLen)) $ \len ->
|
||||
forAll (vectorOf len $ chooseWord8 (0, 255)) $ \list0 ->
|
||||
@ -117,17 +120,17 @@ testWrite hfold =
|
||||
writeFile fpathWrite ""
|
||||
h <- openFile fpathWrite ReadWriteMode
|
||||
hSeek h AbsoluteSeek 0
|
||||
S.fold (hfold h) $ S.fromList list
|
||||
Stream.fold (hfold h) $ Stream.fromList list
|
||||
hFlush h
|
||||
hSeek h AbsoluteSeek 0
|
||||
ls <- S.toList $ S.unfold FH.read h
|
||||
ls <- Stream.toList $ Stream.unfold Handle.read h
|
||||
hClose h
|
||||
return (ls == list)
|
||||
|
||||
testWriteWithChunk :: Property
|
||||
testWriteWithChunk =
|
||||
monadicIO $ do
|
||||
res <- run $ go
|
||||
res <- run go
|
||||
assert res
|
||||
|
||||
where
|
||||
@ -141,12 +144,12 @@ testWriteWithChunk =
|
||||
hr <- openFile fpathRead ReadMode
|
||||
hw <- openFile fpathWrite ReadWriteMode
|
||||
hSeek hw AbsoluteSeek 0
|
||||
S.fold (FH.writeChunks hw)
|
||||
$ S.unfold FH.readChunksWithBufferOf (1024, hr)
|
||||
Stream.fold (Handle.writeChunks hw)
|
||||
$ Stream.unfold Handle.readChunksWithBufferOf (1024, hr)
|
||||
hFlush hw
|
||||
hSeek hw AbsoluteSeek 0
|
||||
ls <- S.toList $ S.unfold FH.read hw
|
||||
let arr = A.fromList ls
|
||||
ls <- Stream.toList $ Stream.unfold Handle.read hw
|
||||
let arr = Array.fromList ls
|
||||
return (testDataLarge == utf8ToString arr)
|
||||
|
||||
main :: IO ()
|
||||
@ -154,12 +157,12 @@ main =
|
||||
hspec $
|
||||
H.parallel $
|
||||
modifyMaxSuccess (const maxTestCount) $ do
|
||||
describe "Read" $ do
|
||||
prop "testRead" $ testRead readFromHandle
|
||||
prop "testReadWithBuffer" $ testRead readWithBufferFromHandle
|
||||
prop "testReadChunks" $ testRead readChunksFromHandle
|
||||
prop "testReadChunksWithBuffer" $ testRead readChunksWithBuffer
|
||||
describe "Write" $ do
|
||||
prop "testWrite" $ testWrite FH.write
|
||||
prop "testWriteWithBufferOf" $ testWrite $ FH.writeWithBufferOf 1024
|
||||
prop "testWriteWithChunk" $ testWriteWithChunk
|
||||
describe "Read From Handle" $ do
|
||||
prop "read" $ testRead readFromHandle
|
||||
prop "readWithBufferOf" $ testRead readWithBufferFromHandle
|
||||
prop "readChunks" $ testRead readChunksFromHandle
|
||||
prop "readChunksWithBufferOf" $ testRead readChunksWithBuffer
|
||||
describe "Write To Handle" $ do
|
||||
prop "write" $ testWrite Handle.write
|
||||
prop "writeWithBufferOf" $ testWrite $ Handle.writeWithBufferOf 1024
|
||||
prop "writeChunks" testWriteWithChunk
|
||||
|
Loading…
Reference in New Issue
Block a user