potoki-core 2.2.10 → 2.2.11
raw patch · 11 files changed
+778/−690 lines, 11 filesdep +criteriondep +splitdep ~rerebase
Dependencies added: criterion, split
Dependency ranges changed: rerebase
Files
- benchmark/Main.hs +19/−0
- library/Potoki/Core/Transform.hs +1/−0
- library/Potoki/Core/Transform/Basic.hs +44/−0
- library/Potoki/Core/Transform/Concurrency.hs +0/−1
- potoki-core.cabal +16/−3
- test/Main.hs +229/−0
- test/Potoki.hs +279/−0
- test/Transform.hs +190/−0
- tests/Main.hs +0/−229
- tests/Potoki.hs +0/−279
- tests/Transform.hs +0/−178
+ benchmark/Main.hs view
@@ -0,0 +1,19 @@+module Main where++import Prelude+import Criterion.Main+import Potoki.Core.IO+import qualified Potoki.Core.Produce as Produce+import qualified Potoki.Core.Consume as Consume+import qualified Potoki.Core.Transform as Transform+++main =+ defaultMain $+ [+ bench "extractLinesTransform" $ whnfIO $ produceAndConsume+ (Produce.fileBytes "data/2.tsv")+ (right' (Consume.transform+ (Transform.extractLines)+ (Consume.count)))+ ]
library/Potoki/Core/Transform.hs view
@@ -14,6 +14,7 @@ just, list, vector,+ chunk, distinctBy, distinct, executeIO,
library/Potoki/Core/Transform/Basic.hs view
@@ -7,6 +7,8 @@ import qualified Data.HashSet as C import qualified Data.Vector as P import qualified Acquire.Acquire as M+import qualified Data.Vector.Generic.Mutable as MutableGenericVector+import qualified Data.Vector.Generic as GenericVector {-# INLINE mapFilter #-}@@ -88,6 +90,48 @@ writeIORef indexRef 0 loop Nothing -> return Nothing+ in loop++{-|+Chunk to vectors of the given size.+Useful as a precursor of 'concurrently' in cases where the lifted transform's iteration is too light.+-}+{-# INLINABLE chunk #-}+chunk :: Int -> Transform a (Vector a)+chunk size = if size < 1+ then Transform $ const $ liftIO $ return $ empty+ else Transform $ \ (Fetch fetch) -> liftIO $ do+ mvec <- MutableGenericVector.new size+ cursor <- newIORef 0+ activeVar <- newIORef True+ return $ Fetch $ let+ loop = do+ active <- readIORef activeVar+ if active+ then do+ fetchingResult <- fetch+ case fetchingResult of+ Just !a -> do+ index <- readIORef cursor+ MutableGenericVector.unsafeWrite mvec index a+ let !nextIndex = succ index+ if nextIndex == size+ then do+ writeIORef cursor 0+ !vec <- GenericVector.freeze mvec+ return (Just vec)+ else do+ writeIORef cursor nextIndex+ loop+ Nothing -> do+ writeIORef activeVar False+ index <- readIORef cursor+ if index > 0+ then do+ !vec <- GenericVector.freeze (MutableGenericVector.unsafeSlice 0 index mvec)+ return (Just vec)+ else return Nothing+ else return Nothing in loop {-# INLINE distinctBy #-}
library/Potoki/Core/Transform/Concurrency.hs view
@@ -103,7 +103,6 @@ Transform $ \ fetchIO -> liftIO $ do chan <- newTBQueueIO (workersAmount * 2) workersCounter <- newTVarIO workersAmount- fetchingAvailableVar <- newTVarIO True replicateM_ workersAmount $ forkIO $ do (A.Fetch fetchIO, finalize) <- case syncTransformIO fetchIO of M.Acquire io -> io
potoki-core.cabal view
@@ -1,5 +1,5 @@ name: potoki-core-version: 2.2.10+version: 2.2.11 synopsis: Low-level components of "potoki" description: Provides everything required for building custom instances of@@ -63,9 +63,9 @@ unordered-containers >=0.2 && <0.3, vector >=0.12 && <0.13 -test-suite tests+test-suite test type: exitcode-stdio-1.0- hs-source-dirs: tests+ hs-source-dirs: test main-is: Main.hs default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language: Haskell2010@@ -77,6 +77,7 @@ attoparsec, foldl >=1.3.7 && <1.4, ilist >=0.3.1.0 && <0.4,+ split >=0.2.3.3 && <0.3, potoki-core, QuickCheck >=2.8.1 && <3, quickcheck-instances >=0.3.11 && <0.4,@@ -85,3 +86,15 @@ tasty >=1.0.1 && <1.2, tasty-hunit >=0.10 && <0.11, tasty-quickcheck >=0.10 && <0.11++benchmark benchmark+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmark+ default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language: Haskell2010+ ghc-options: -O2 -threaded "-with-rtsopts=-N -A64M"+ main-is: Main.hs+ build-depends:+ criterion >=1.5.1 && <2,+ potoki-core,+ rerebase >=1 && <2
+ test/Main.hs view
@@ -0,0 +1,229 @@+module Main where++import Prelude hiding (first, second)+import Control.Arrow+import Test.QuickCheck.Instances+import Test.QuickCheck.Monadic as M+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Potoki.Core.IO as C+import qualified Potoki.Core.Consume as D+import qualified Potoki.Core.Transform as A+import qualified Potoki.Core.Produce as E+import qualified Potoki.Core.Fetch as Fe+import qualified Data.Attoparsec.ByteString.Char8 as B+import qualified Data.ByteString as F+import qualified Data.Vector as G+import qualified System.Random as H+import qualified Acquire.Acquire as Ac+import Potoki+import Transform++main =+ defaultMain $+ testGroup "All tests" $+ [+ testCase "extractLinesWithoutTrail" $ do+ assertEqual "" ["ab", "", "cd"] =<<+ C.produceAndConsume (E.transform A.extractLinesWithoutTrail (E.list ["a", "b\n", "\nc", "d\n"])) D.list+ ,+ testCase "extractLines" $ do+ assertEqual "" ["ab", "", "cd", ""] =<<+ C.produceAndConsume (E.transform A.extractLines (E.list ["a", "b\n", "\nc", "d\n"])) D.list+ ,+ testProperty "list to list" $ \ (list :: [Int]) ->+ list === unsafePerformIO (C.produceAndConsume (E.list list) D.list)+ ,+ testProperty "consecutive consumers" $ \ (list :: [Int], amount) ->+ list === unsafePerformIO (C.produceAndConsume (E.list list) ((++) <$> D.transform (A.take amount) D.list <*> D.list))+ ,+ potoki+ ,+ transform+ ,+ resourceChecker+ ,+ testCase "sync resource checker" $ do+ resourceVar <- newIORef Initial+ let produce = syncCheckResource resourceVar+ C.produceAndConsume produce D.sum+ fin <- readIORef resourceVar+ assertEqual "" Released fin+ ,+ testCase "async resource checker" $ do+ resourceVar <- newTVarIO Initial+ let produce = asyncCheckResource resourceVar+ potokiThreadId <- forkIO $ do+ C.produceAndConsume produce D.sum+ return ()+ atomically $ do+ resource <- readTVar resourceVar+ guard $ resource == Acquired+ killThread potokiThreadId+ atomically $ do+ resource <- readTVar resourceVar+ guard $ resource == Released+ ,+ testProperty "Produce.transform resource checker" $ \ (list :: [Int]) ->+ let prod = E.list list+ in monadicIO $ do+ check <- run $ do+ resourceVar1 <- newIORef Initial+ res <- C.produceAndConsume (E.transform (checkTransform resourceVar1) prod) D.sum+ readIORef resourceVar1+ M.assert $ check == Released+ ,+ testProperty "Consume.transform resource checker" $ \ (list :: [Int]) ->+ let prod = E.list list+ in monadicIO $ do+ check <- run $ do+ resourceVar1 <- newIORef Initial+ res <- C.produceAndConsume prod (D.transform (checkTransform resourceVar1) D.sum)+ readIORef resourceVar1+ M.assert $ check == Released+ ,+ testCase "Transform.produce resource checker #1" $ do+ resourceVar <- newIORef Initial+ let prod = checkProduce resourceVar (/= Released) 100+ res1 <- C.produceAndConsume (E.transform (A.produce intToProduce) prod) D.sum+ res2 <- C.produceAndConsume prod (D.transform (A.produce intToProduce) D.sum)+ fin <- readIORef resourceVar+ assertEqual "" Released fin+ assertEqual "" res1 res2+ ,+ testCase "Transform.produce resource checker #2" $ do+ resourceVar <- newIORef Initial+ let prod = checkProduce resourceVar (/= Released) 100+ res1 <- C.produceAndConsume (E.transform (A.take 5 >>> A.produce intToProduce) prod) D.sum+ res2 <- C.produceAndConsume prod (D.transform (A.take 5 >>> A.produce intToProduce) D.sum)+ fin <- readIORef resourceVar+ assertEqual "" Released fin+ assertEqual "" res1 res2+ ]++resourceChecker :: TestTree+resourceChecker =+ testGroup "produce1 >>= produce2" $+ [+ testCase "Check produce binding" $ do+ resourceVar1 <- newIORef Initial+ resourceVar2 <- newIORef Initial+ let prod1 = checkProduce resourceVar1 (const True) 100+ prod2 = \x -> checkProduce resourceVar2 (/= Released) x+ res <- C.produceAndConsume (prod1 >>= prod2) D.sum+ fin <- readIORef resourceVar1+ assertEqual "" Released fin+ ,+ testProperty "Bind for produce" $ \ (list :: [Int]) ->+ let check = list >>= (enumFromTo 0)+ prod1 = E.list list+ prod2 = \x -> E.list $ enumFromTo 0 x+ in monadicIO $ do+ res <- run $ C.produceAndConsume (prod1 >>= prod2) D.list+ M.assert (check == res)+ ,+ testProperty "liftIO for Produce. Consume0" $ \ (_ :: Int) ->+ monadicIO $ do+ check <- run $ do+ checkVar <- newIORef False+ let prod = liftIO $ writeIORef checkVar True+ C.produceAndConsume prod someThing+ readIORef checkVar+ M.assert $ check == False+ ,+ testProperty "liftIO for Produce. ConsumeN" $ \ (n :: Int) ->+ monadicIO $ do+ let prod = liftIO (return n)+ len <- run (C.produceAndConsume prod D.count)+ M.assert (len == 1)+ ]++intToProduce :: Int -> E.Produce Int+intToProduce a = E.Produce . Ac.Acquire $ do+ stVar <- newIORef 0+ return $ flip (,) (return ()) $ Fe.Fetch $ do+ n <- readIORef stVar+ if n >= a + 1 then (return Nothing)+ else do+ writeIORef stVar $! n + 1+ return (Just n)++someThing :: D.Consume input Int+someThing = D.Consume $ \ (Fe.Fetch _) -> return 0++single :: Foldable f => f a -> Maybe a+single = join . (foldr' f Nothing)+ where+ f x Nothing = Just $ Just x+ f _ _ = Just Nothing++data Resource+ = Initial+ | Acquired+ | Released+ | AcquiredImproperly+ | ReleasedImproperly+ deriving (Show, Eq)++checkTransform :: IORef Resource -> A.Transform Int Int+checkTransform resourceVar = A.Transform $ \ fetchIO -> Ac.Acquire $ do+ writeIORef resourceVar Acquired+ return $ (,) (plusFetch fetchIO) $ do+ res <- readIORef resourceVar+ case res of+ Acquired -> writeIORef resourceVar Released+ _ -> writeIORef resourceVar ReleasedImproperly++plusFetch :: Fe.Fetch Int -> Fe.Fetch Int+plusFetch (Fe.Fetch fetchIO) = Fe.Fetch $ do+ fetch <- fetchIO+ return $ fmap succ fetch++checkProduce :: IORef Resource -> (Resource -> Bool) -> Int -> E.Produce Int+checkProduce resourceVar f k = E.Produce . Ac.Acquire $ do+ res <- readIORef resourceVar+ if f res && res /= Initial+ then do+ return $ (,) (Fe.Fetch $ return Nothing) $ writeIORef resourceVar AcquiredImproperly+ else do+ writeIORef resourceVar Acquired+ stVar <- newIORef 0+ let fetch = do+ n <- readIORef stVar+ if n >= k then return (Nothing)+ else do+ writeIORef stVar $! n + 1+ return (Just n)+ return $ (,) (Fe.Fetch fetch) $ do+ res <- readIORef resourceVar+ case res of+ Acquired -> writeIORef resourceVar Released+ _ -> writeIORef resourceVar ReleasedImproperly++asyncCheckResource :: TVar Resource -> E.Produce Int+asyncCheckResource resourceVar = E.Produce . Ac.Acquire $ do+ atomically $ writeTVar resourceVar Acquired+ stVar <- newIORef 0+ let fetch = do+ n <- readIORef stVar+ writeIORef stVar $! n + 1+ return (Just n)+ return (Fe.Fetch fetch, atomically $ writeTVar resourceVar Released)++syncCheckResource :: IORef Resource -> E.Produce Int+syncCheckResource resourceVar = E.Produce . Ac.Acquire $ do+ writeIORef resourceVar Acquired+ stVar <- newIORef 0+ let fetch = do+ n <- readIORef stVar+ if n >= 1000 then return (Nothing)+ else do+ writeIORef stVar $! n + 1+ return (Just n)+ return $ (,) (Fe.Fetch fetch) $ do+ res <- readIORef resourceVar+ case res of+ Acquired -> writeIORef resourceVar Released+ _ -> writeIORef resourceVar ReleasedImproperly
+ test/Potoki.hs view
@@ -0,0 +1,279 @@+module Potoki where++import Prelude hiding (first, second)+import Control.Arrow+import Test.QuickCheck.Instances+import Test.QuickCheck.Monadic as M+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Control.Foldl as Fl+import qualified Potoki.Core.IO as C+import qualified Potoki.Core.Consume as D+import qualified Potoki.Core.Transform as A+import qualified Potoki.Core.Produce as E+import qualified Data.Attoparsec.ByteString.Char8 as B+import qualified Data.ByteString as F+import qualified Data.Vector as G+import qualified System.Random as H+import Data.List.Index (indexed)++potoki :: TestTree+potoki =+ testGroup "All tests for potoki's end-users functions" $+ [+ testCase "vector to list" $ do+ result <- C.produceAndConsume (E.vector (G.fromList [1,2,3])) (D.list)+ assertEqual "" [1,2,3] result+ ,+ testCase "just" $ do+ result <- C.produceAndConsume (E.list [Just 1, Nothing, Just 2]) (D.transform A.just D.list)+ assertEqual "" [1,2] result+ ,+ testCase "transform,consume,take" $ do+ let+ transform = A.consume (D.transform (A.take 3) D.list)+ consume = D.transform transform D.list+ produceAndConsume list = C.produceAndConsume (E.list list) (consume)+ assertEqual "" [[1,2,3], [4,5,6], [7,8]] =<< produceAndConsume [1,2,3,4,5,6,7,8]+ assertEqual "" [[1,2,3], [4,5,6], [7,8,9]] =<< produceAndConsume [1,2,3,4,5,6,7,8,9]+ assertEqual "" [] =<< produceAndConsume ([] :: [Int])+ ,+ testCase "File reading" $ do+ let produce =+ E.transform (arr (either (const Nothing) Just) >>> A.just) $+ E.fileBytes "samples/1"+ result <- C.produceAndConsume produce (fmap F.length D.concat)+ assertEqual "" 17400 result+ ,+ transformPotoki+ ,+ parsingPotoki+ ,+ consumePotoki+ ]+++transformPotoki :: TestTree+transformPotoki =+ testGroup "Transform" $+ [+ testCase "Order" $ do+ let+ list = [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3]+ transform = left (A.consume (D.transform (A.take 2) D.sum))+ result <- C.produceAndConsume (E.list list) (D.transform transform D.list)+ assertEqual "" [Left 3, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 7] result+ ,+ testCase "Interrupted order" $ do+ let+ list = [Left 1, Left 2, Right 'a']+ transform = left (A.consume (D.transform (A.take 3) D.sum))+ result <- C.produceAndConsume (E.list list) (D.transform transform D.list)+ assertEqual "" [Left 3, Right 'a'] result+ ,+ testCase "Distinct" $ do+ let+ list = [1,2,3,2,3,2,1,4,1] :: [Int]+ result <- C.produceAndConsume (E.list list) (D.transform A.distinct D.list)+ assertEqual "" [1,2,3,4] result+ ,+ testCase "Distinct By" $ do+ let+ list = [(1, ""),(2, ""),(3, ""),(2, ""),(3, ""),(2, ""),(1, ""),(4, ""),(1, "")] :: [(Int, String)]+ result <- C.produceAndConsume (E.list list) (D.transform (A.distinctBy fst) D.list)+ assertEqual "" [(1, ""),(2, ""),(3, ""),(4, "")] result+ ,+ testCase "Concurrently" $ do+ let+ list = [1..20000]+ produce = E.list list+ transform =+ A.concurrently 12 $+ arr (\ x -> H.randomRIO (0, 100) >>= threadDelay >> return x) >>>+ A.executeIO+ consume = D.transform transform D.list+ result <- C.produceAndConsume produce consume+ assertBool "Is dispersed" (list /= result)+ assertEqual "Contains no duplicates" 0 (length result - length (nub result))+ assertEqual "Equals the original once sorted" list (sort result)+ ,+ testProperty "Line" $ \ chunks ->+ let+ expected =+ mconcat chunks+ actual =+ unsafePerformIO (C.produceAndConsume produce consume)+ where+ produce =+ E.list chunks+ consume =+ rmap (mconcat . intersperse "\n") $+ D.transform A.extractLines D.list+ in expected === actual+ ,+ testProperty "takeWhile" $ \ (list :: [Int]) ->+ let listPart = takeWhile odd list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndTransformAndConsume prod (A.takeWhile odd) D.list)+ M.assert (res == listPart)+ ,+ testProperty "mapFilter" $ \ (list :: [Int]) ->+ let in2MaybeOut input =+ if input `mod` 4 == 0+ then Just $ input `mod` 4+ else Nothing+ filteredList = map fromJust . filter (/= Nothing) . map in2MaybeOut $ list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndTransformAndConsume prod (A.mapFilter in2MaybeOut) D.list)+ M.assert (res == filteredList)+ ,+ testProperty "filter" $ \ (list :: [Int]) ->+ let filteredList = filter even list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndTransformAndConsume prod (A.filter even) D.list)+ M.assert (res == filteredList)+ ]++parsingPotoki :: TestTree+parsingPotoki =+ testGroup "Parsing" $+ [+ testCase "Sample 1" $ do+ let parser = B.double <* B.char ','+ transform = arr (either (const Nothing) Just) >>> A.just >>> A.parseBytes parser+ produce = E.transform transform (E.fileBytes "samples/1")+ result <- C.produceAndConsume produce D.count+ assertEqual "" 4350 result+ ,+ testCase "Sample 1 greedy" $ do+ let parser = B.sepBy B.double (B.char ',')+ transform = arr (either (const Nothing) Just) >>> A.just >>> A.parseBytes parser+ produce = E.transform transform (E.fileBytes "samples/1")+ result <- C.produceAndConsume produce D.list+ assertEqual "" [Right 4350] (fmap (fmap length) result)+ ,+ testCase "Split chunk" $+ let+ produce = E.list ["1", "2", "3"]+ parser = B.anyChar+ transform = A.parseBytes parser >>> arr (either (const Nothing) Just) >>> A.just+ consume = D.transform transform D.count+ in do+ assertEqual "" 3 =<< C.produceAndConsume produce consume+ ]++consumePotoki =+ testGroup "Consume" $+ [+ testProperty "count" $ \ (list :: [Int]) ->+ let n = length list+ in monadicIO $ do+ let prod = E.list list+ len <- run (C.produceAndConsume prod D.count)+ M.assert (len == n)+ ,+ testProperty "sum" $ \ (list :: [Int]) ->+ let n = sum list+ in monadicIO $ do+ let prod = E.list list+ len <- run (C.produceAndConsume prod D.sum)+ M.assert (len == n)+ ,+ testProperty "head" $ \ (list :: [Int]) ->+ let el = if null list then Nothing else (Just (head list))+ in monadicIO $ do+ let prod = E.list list+ he <- run (C.produceAndConsume prod D.head)+ M.assert (he == el)+ ,+ testProperty "last" $ \ (list :: [Int]) ->+ let el = if null list then Nothing else (Just (last list))+ in monadicIO $ do+ let prod = E.list list+ he <- run (C.produceAndConsume prod D.last)+ M.assert (he == el)+ ,+ testProperty "list" $ \ (list :: [Int]) ->+ monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod D.list)+ M.assert (res == list)+ ,+ testProperty "reverseList" $ \ (list :: [Int]) ->+ let revList = reverse list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod D.reverseList)+ M.assert (res == revList)+ ,+ testProperty "vector" $ \ (list :: [Int]) ->+ let vec = G.fromList list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod D.vector)+ M.assert (res == vec)+ ,+ testProperty "concat" $ \ (list :: [[Int]]) ->+ let con = concat list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod D.concat)+ M.assert (res == con)+ ,+ testProperty "fold" $ \ (list :: [Int], fun :: (Fun (Int, Int) Int), first :: Int) ->+ let f = applyFun2 fun+ fol = foldl' f first list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod (D.fold (Fl.Fold f first id)))+ M.assert (res == fol)+ ,+ testProperty "foldInIO" $ \ (list :: [Int]) ->+ let fin = sum list+ in monadicIO $ do+ let prod = E.list list+ res <- run $ do+ sumVar <- newIORef 0+ (C.produceAndConsume prod (D.foldInIO (Fl.FoldM (\_ a -> modifyIORef' sumVar (a+)) (pure ()) (\_ -> readIORef sumVar)) ) )+ M.assert (res == fin)+ ,+ testProperty "folding" $ \ (list :: [Int], fun :: (Fun (Int, Int) Int), first :: Int) ->+ let f = applyFun2 fun+ fol = foldl' f first list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod (D.folding (Fl.Fold f first id) (D.sum) ))+ a <- run (C.produceAndConsume prod D.sum)+ M.assert (res == (fol, a))+ ,+ testProperty "foldingInIO" $ \ (list :: [Int]) ->+ let fol = sum list+ in monadicIO $ do+ let prod = E.list list+ res <- run $ do+ sumVar <- newIORef 0+ (C.produceAndConsume prod (D.foldingInIO (Fl.FoldM (\_ a -> modifyIORef' sumVar (a+)) (pure ()) (\_ -> readIORef sumVar)) (D.sum) ))+ a <- run (C.produceAndConsume prod D.sum)+ M.assert (res == (fol, a))+ ,+ testProperty "execState" $ \ (list :: [Int]) ->+ let f = modify' . (+)+ resL = sum list+ in monadicIO $ do+ let prod = E.list list+ res <- run (C.produceAndConsume prod (D.execState f 0))+ M.assert (res == resL)+ ,+ testProperty "Choice consume right'" $ \ (list :: [Either Bool Int]) ->+ let n = sum <$> sequence list+ in monadicIO $ do+ let prod = E.list list+ len <- run (C.produceAndConsume prod $ right' D.sum)+ M.assert (len == n)+ ]+
+ test/Transform.hs view
@@ -0,0 +1,190 @@+module Transform where++import Prelude hiding (first, second, choose)+import Control.Arrow+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.Runners+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Potoki.Core.IO as C+import qualified Potoki.Core.Consume as D+import qualified Potoki.Core.Transform as A+import qualified Potoki.Core.Produce as E+import qualified Data.Attoparsec.ByteString.Char8 as B+import qualified Data.ByteString as F+import qualified Data.Vector as G+import qualified Data.List.Split as SplitList+import qualified System.Random as H++transform :: TestTree+transform =+ testGroup "Transform" $+ [+ testProperty "Applying chunksOf to list has the same effect as the \"chunk\" transform" $ let+ gen = do+ list <- listOf (choose (0, 1000 :: Int))+ chunkSize <- frequency [(1000, choose (1, 3)), (100, choose (4, 100)), (1, pure 0)]+ traceShowM (list, chunkSize)+ return (list, chunkSize)+ in forAll gen $ \ (list, chunkSize) -> let+ listChunks = if chunkSize < 1 then [] else SplitList.chunksOf chunkSize list+ potokiChunks = unsafePerformIO $ C.produceAndTransformAndConsume (E.list list) (rmap toList (A.chunk chunkSize)) D.list+ in listChunks === potokiChunks+ ,+ transformProduce+ ,+ transformChoice+ ,+ transformArrowLaws+ ]++transformProduce =+ testGroup "Produce" $+ [+ testCase "1" $ do+ let+ list = [1, 2, 3] :: [Int]+ result <- C.produceAndTransformAndConsume+ (E.list list)+ (A.produce (E.list . \ n -> flip replicate n n))+ (D.list)+ assertEqual "" [1, 2, 2, 3, 3, 3] result+ ,+ testCase "2" $ do+ let+ list = [1, 2, 3] :: [Int]+ result <- C.produceAndTransformAndConsume+ (E.list list)+ (A.produce (E.list . \ n -> [(n, n)]))+ (D.list)+ assertEqual "" [(1, 1), (2, 2), (3, 3)] result+ ,+ testCase "3" $ do+ let+ list = [1, 2, 3] :: [Int]+ result <- C.produceAndTransformAndConsume+ (E.list list)+ (A.produce (E.list . \ n -> [n, n]))+ (D.list)+ assertEqual "" [1, 1, 2, 2, 3, 3] result+ ]++transformChoice =+ testGroup "Choice" $+ [+ testCase "1" $ do+ let+ list = [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3]+ transform = left' id+ result <- C.produceAndTransformAndConsume (E.list list) transform D.list+ assertEqual "" [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3] result+ ,+ testCase "2" $ do+ let+ list = [Left 1, Left 2, Right 'z', Right 'a', Right 'b', Left 0, Right 'x', Left 4, Left 3]+ transform = right' (A.consume D.list)+ result <- C.produceAndTransformAndConsume (E.list list) transform D.list+ assertEqual "" [Left 1, Left 2, Right "zab", Left 0, Right "x", Left 4, Left 3] result+ ,+ testCase "3" $ do+ let+ list = [Left 4, Right 'z', Right 'a', Left 3, Right 'b', Left 0, Left 1, Right 'x', Left 4, Left 3]+ transform = left' (A.consume D.list)+ result <- C.produceAndTransformAndConsume (E.list list) transform D.list+ assertEqual "" [Left [4], Right 'z', Right 'a', Left [3], Right 'b', Left [0, 1], Right 'x', Left [4, 3]] result+ ]++transformArrowLaws =+ testGroup "Arrow laws"+ [+ testGroup "Strong"+ [+ testCase "1" $ do+ let+ input = [(1,'a'),(2,'b'),(3,'c'),(4,'d')]+ transform = first transform1+ result <- C.produceAndTransformAndConsume (E.list input) transform D.list+ assertEqual "" [(6,'c'),(4,'d')] result+ ,+ testCase "Lack of elements" $ do+ let+ input = [(1,'a'),(2,'b')]+ transform = first transform1+ result <- C.produceAndTransformAndConsume (E.list input) transform D.list+ assertEqual "" [(3,'b')] result+ ]+ ,+ transformProperty "arr id = id"+ (arr id :: A.Transform Int Int)+ id+ ,+ transformProperty "arr (f >>> g) = arr f >>> arr g"+ (arr (f >>> g))+ (arr f >>> arr g)+ ,+ transformProperty "first (arr f) = arr (first f)"+ (first (arr f) :: A.Transform (Int, Char) (Int, Char))+ (arr (first f))+ ,+ transformProperty "first (f >>> g) = first f >>> first g"+ (first (transform1 >>> transform2) :: A.Transform (Int, Char) (Int, Char))+ (first (transform1) >>> first (transform2))+ ,+ transformProperty "first f >>> arr fst = arr fst >>> f"+ (first transform1 >>> arr fst :: A.Transform (Int, Char) Int)+ (arr fst >>> transform1)+ ,+ transformProperty "first f >>> arr (id *** g) = arr (id *** g) >>> first f"+ (first transform1 >>> arr (id *** g))+ (arr (id *** g) >>> first transform1)+ ,+ transformProperty "first (first f) >>> arr assoc = arr assoc >>> first f"+ (first (first transform1) >>> arr assoc :: A.Transform ((Int, Char), Double) (Int, (Char, Double)))+ (arr assoc >>> first transform1)+ ,+ transformProperty "left (arr f) = arr (left f)"+ (left (arr f) :: A.Transform (Either Int Char) (Either Int Char))+ (arr (left f))+ ,+ transformProperty "left (f >>> g) = left f >>> left g"+ (left (transform1 >>> transform2) :: A.Transform (Either Int Char) (Either Int Char))+ (left (transform1) >>> left (transform2))+ ,+ transformProperty "f >>> arr Left = arr Left >>> left f"+ (transform1 >>> arr Left :: A.Transform Int (Either Int Char))+ (arr Left >>> left transform1)+ ,+ transformProperty "left f >>> arr (id +++ g) = arr (id +++ g) >>> left f"+ (left transform1 >>> arr (id +++ g))+ (arr (id +++ g) >>> left transform1)+ ,+ transformProperty "left (left f) >>> arr assocsum = arr assocsum >>> left f"+ (left (left transform1) >>> arr assocsum :: A.Transform (Either (Either Int Char) Double) (Either Int (Either Char Double)))+ (arr assocsum >>> left transform1)+ ,+ transformProperty "left (left (arr f)) >>> arr assocsum = arr assocsum >>> left (arr f)"+ (left (left (arr f)) >>> arr assocsum :: A.Transform (Either (Either Int Char) Double) (Either Int (Either Char Double)))+ (arr assocsum >>> left (arr f))+ ]+ where+ f = (+24) :: Int -> Int+ g = (*3) :: Int -> Int+ transform1 = A.consume (D.transform (A.take 3) D.sum) :: A.Transform Int Int+ transform2 = A.consume (D.transform (A.take 4) D.sum) :: A.Transform Int Int+ assoc ((a,b),c) = (a,(b,c))+ assocsum (Left (Left x)) = Left x+ assocsum (Left (Right y)) = Right (Left y)+ assocsum (Right z) = Right (Right z)++transformProperty ::+ (Arbitrary input, Show input, Eq output, Show output) =>+ String -> A.Transform input output -> A.Transform input output -> TestTree+transformProperty name leftTransform rightTransform =+ testProperty name property+ where+ property list =+ transform leftTransform === transform rightTransform+ where+ transform transform =+ unsafePerformIO (C.produceAndTransformAndConsume (E.list list) transform D.list)
− tests/Main.hs
@@ -1,229 +0,0 @@-module Main where--import Prelude hiding (first, second)-import Control.Arrow-import Test.QuickCheck.Instances-import Test.QuickCheck.Monadic as M-import Test.Tasty-import Test.Tasty.Runners-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-import qualified Potoki.Core.IO as C-import qualified Potoki.Core.Consume as D-import qualified Potoki.Core.Transform as A-import qualified Potoki.Core.Produce as E-import qualified Potoki.Core.Fetch as Fe-import qualified Data.Attoparsec.ByteString.Char8 as B-import qualified Data.ByteString as F-import qualified Data.Vector as G-import qualified System.Random as H-import qualified Acquire.Acquire as Ac-import Potoki-import Transform--main =- defaultMain $- testGroup "All tests" $- [- testCase "extractLinesWithoutTrail" $ do- assertEqual "" ["ab", "", "cd"] =<<- C.produceAndConsume (E.transform A.extractLinesWithoutTrail (E.list ["a", "b\n", "\nc", "d\n"])) D.list- ,- testCase "extractLines" $ do- assertEqual "" ["ab", "", "cd", ""] =<<- C.produceAndConsume (E.transform A.extractLines (E.list ["a", "b\n", "\nc", "d\n"])) D.list- ,- testProperty "list to list" $ \ (list :: [Int]) ->- list === unsafePerformIO (C.produceAndConsume (E.list list) D.list)- ,- testProperty "consecutive consumers" $ \ (list :: [Int], amount) ->- list === unsafePerformIO (C.produceAndConsume (E.list list) ((++) <$> D.transform (A.take amount) D.list <*> D.list))- ,- potoki- ,- transform- ,- resourceChecker- ,- testCase "sync resource checker" $ do- resourceVar <- newIORef Initial- let produce = syncCheckResource resourceVar- C.produceAndConsume produce D.sum- fin <- readIORef resourceVar- assertEqual "" Released fin- ,- testCase "async resource checker" $ do- resourceVar <- newTVarIO Initial- let produce = asyncCheckResource resourceVar- potokiThreadId <- forkIO $ do- C.produceAndConsume produce D.sum- return ()- atomically $ do- resource <- readTVar resourceVar- guard $ resource == Acquired- killThread potokiThreadId- atomically $ do- resource <- readTVar resourceVar- guard $ resource == Released- ,- testProperty "Produce.transform resource checker" $ \ (list :: [Int]) ->- let prod = E.list list- in monadicIO $ do- check <- run $ do- resourceVar1 <- newIORef Initial- res <- C.produceAndConsume (E.transform (checkTransform resourceVar1) prod) D.sum- readIORef resourceVar1- M.assert $ check == Released- ,- testProperty "Consume.transform resource checker" $ \ (list :: [Int]) ->- let prod = E.list list- in monadicIO $ do- check <- run $ do- resourceVar1 <- newIORef Initial- res <- C.produceAndConsume prod (D.transform (checkTransform resourceVar1) D.sum)- readIORef resourceVar1- M.assert $ check == Released- ,- testCase "Transform.produce resource checker #1" $ do- resourceVar <- newIORef Initial- let prod = checkProduce resourceVar (/= Released) 100- res1 <- C.produceAndConsume (E.transform (A.produce intToProduce) prod) D.sum- res2 <- C.produceAndConsume prod (D.transform (A.produce intToProduce) D.sum)- fin <- readIORef resourceVar- assertEqual "" Released fin- assertEqual "" res1 res2- ,- testCase "Transform.produce resource checker #2" $ do- resourceVar <- newIORef Initial- let prod = checkProduce resourceVar (/= Released) 100- res1 <- C.produceAndConsume (E.transform (A.take 5 >>> A.produce intToProduce) prod) D.sum- res2 <- C.produceAndConsume prod (D.transform (A.take 5 >>> A.produce intToProduce) D.sum)- fin <- readIORef resourceVar- assertEqual "" Released fin- assertEqual "" res1 res2- ]--resourceChecker :: TestTree-resourceChecker =- testGroup "produce1 >>= produce2" $- [- testCase "Check produce binding" $ do- resourceVar1 <- newIORef Initial- resourceVar2 <- newIORef Initial- let prod1 = checkProduce resourceVar1 (const True) 100- prod2 = \x -> checkProduce resourceVar2 (/= Released) x- res <- C.produceAndConsume (prod1 >>= prod2) D.sum- fin <- readIORef resourceVar1- assertEqual "" Released fin- ,- testProperty "Bind for produce" $ \ (list :: [Int]) ->- let check = list >>= (enumFromTo 0)- prod1 = E.list list- prod2 = \x -> E.list $ enumFromTo 0 x- in monadicIO $ do- res <- run $ C.produceAndConsume (prod1 >>= prod2) D.list- M.assert (check == res)- ,- testProperty "liftIO for Produce. Consume0" $ \ (_ :: Int) ->- monadicIO $ do- check <- run $ do- checkVar <- newIORef False- let prod = liftIO $ writeIORef checkVar True- C.produceAndConsume prod someThing- readIORef checkVar- M.assert $ check == False- ,- testProperty "liftIO for Produce. ConsumeN" $ \ (n :: Int) ->- monadicIO $ do- let prod = liftIO (return n)- len <- run (C.produceAndConsume prod D.count)- M.assert (len == 1)- ]--intToProduce :: Int -> E.Produce Int-intToProduce a = E.Produce . Ac.Acquire $ do- stVar <- newIORef 0- return $ flip (,) (return ()) $ Fe.Fetch $ do- n <- readIORef stVar- if n >= a + 1 then (return Nothing)- else do- writeIORef stVar $! n + 1- return (Just n)--someThing :: D.Consume input Int-someThing = D.Consume $ \ (Fe.Fetch _) -> return 0--single :: Foldable f => f a -> Maybe a-single = join . (foldr' f Nothing)- where- f x Nothing = Just $ Just x- f _ _ = Just Nothing--data Resource- = Initial- | Acquired- | Released- | AcquiredImproperly- | ReleasedImproperly- deriving (Show, Eq)--checkTransform :: IORef Resource -> A.Transform Int Int-checkTransform resourceVar = A.Transform $ \ fetchIO -> Ac.Acquire $ do- writeIORef resourceVar Acquired- return $ (,) (plusFetch fetchIO) $ do- res <- readIORef resourceVar- case res of- Acquired -> writeIORef resourceVar Released- _ -> writeIORef resourceVar ReleasedImproperly--plusFetch :: Fe.Fetch Int -> Fe.Fetch Int-plusFetch (Fe.Fetch fetchIO) = Fe.Fetch $ do- fetch <- fetchIO- return $ fmap succ fetch--checkProduce :: IORef Resource -> (Resource -> Bool) -> Int -> E.Produce Int-checkProduce resourceVar f k = E.Produce . Ac.Acquire $ do- res <- readIORef resourceVar- if f res && res /= Initial- then do- return $ (,) (Fe.Fetch $ return Nothing) $ writeIORef resourceVar AcquiredImproperly- else do- writeIORef resourceVar Acquired- stVar <- newIORef 0- let fetch = do- n <- readIORef stVar- if n >= k then return (Nothing)- else do- writeIORef stVar $! n + 1- return (Just n)- return $ (,) (Fe.Fetch fetch) $ do- res <- readIORef resourceVar- case res of- Acquired -> writeIORef resourceVar Released- _ -> writeIORef resourceVar ReleasedImproperly--asyncCheckResource :: TVar Resource -> E.Produce Int-asyncCheckResource resourceVar = E.Produce . Ac.Acquire $ do- atomically $ writeTVar resourceVar Acquired- stVar <- newIORef 0- let fetch = do- n <- readIORef stVar- writeIORef stVar $! n + 1- return (Just n)- return (Fe.Fetch fetch, atomically $ writeTVar resourceVar Released)--syncCheckResource :: IORef Resource -> E.Produce Int-syncCheckResource resourceVar = E.Produce . Ac.Acquire $ do- writeIORef resourceVar Acquired- stVar <- newIORef 0- let fetch = do- n <- readIORef stVar- if n >= 1000 then return (Nothing)- else do- writeIORef stVar $! n + 1- return (Just n)- return $ (,) (Fe.Fetch fetch) $ do- res <- readIORef resourceVar- case res of- Acquired -> writeIORef resourceVar Released- _ -> writeIORef resourceVar ReleasedImproperly
− tests/Potoki.hs
@@ -1,279 +0,0 @@-module Potoki where--import Prelude hiding (first, second)-import Control.Arrow-import Test.QuickCheck.Instances-import Test.QuickCheck.Monadic as M-import Test.Tasty-import Test.Tasty.Runners-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-import qualified Control.Foldl as Fl-import qualified Potoki.Core.IO as C-import qualified Potoki.Core.Consume as D-import qualified Potoki.Core.Transform as A-import qualified Potoki.Core.Produce as E-import qualified Data.Attoparsec.ByteString.Char8 as B-import qualified Data.ByteString as F-import qualified Data.Vector as G-import qualified System.Random as H-import Data.List.Index (indexed)--potoki :: TestTree-potoki =- testGroup "All tests for potoki's end-users functions" $- [- testCase "vector to list" $ do- result <- C.produceAndConsume (E.vector (G.fromList [1,2,3])) (D.list)- assertEqual "" [1,2,3] result- ,- testCase "just" $ do- result <- C.produceAndConsume (E.list [Just 1, Nothing, Just 2]) (D.transform A.just D.list)- assertEqual "" [1,2] result- ,- testCase "transform,consume,take" $ do- let- transform = A.consume (D.transform (A.take 3) D.list)- consume = D.transform transform D.list- produceAndConsume list = C.produceAndConsume (E.list list) (consume)- assertEqual "" [[1,2,3], [4,5,6], [7,8]] =<< produceAndConsume [1,2,3,4,5,6,7,8]- assertEqual "" [[1,2,3], [4,5,6], [7,8,9]] =<< produceAndConsume [1,2,3,4,5,6,7,8,9]- assertEqual "" [] =<< produceAndConsume ([] :: [Int])- ,- testCase "File reading" $ do- let produce =- E.transform (arr (either (const Nothing) Just) >>> A.just) $- E.fileBytes "samples/1"- result <- C.produceAndConsume produce (fmap F.length D.concat)- assertEqual "" 17400 result- ,- transformPotoki- ,- parsingPotoki- ,- consumePotoki- ]---transformPotoki :: TestTree-transformPotoki =- testGroup "Transform" $- [- testCase "Order" $ do- let- list = [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3]- transform = left (A.consume (D.transform (A.take 2) D.sum))- result <- C.produceAndConsume (E.list list) (D.transform transform D.list)- assertEqual "" [Left 3, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 7] result- ,- testCase "Interrupted order" $ do- let- list = [Left 1, Left 2, Right 'a']- transform = left (A.consume (D.transform (A.take 3) D.sum))- result <- C.produceAndConsume (E.list list) (D.transform transform D.list)- assertEqual "" [Left 3, Right 'a'] result- ,- testCase "Distinct" $ do- let- list = [1,2,3,2,3,2,1,4,1] :: [Int]- result <- C.produceAndConsume (E.list list) (D.transform A.distinct D.list)- assertEqual "" [1,2,3,4] result- ,- testCase "Distinct By" $ do- let- list = [(1, ""),(2, ""),(3, ""),(2, ""),(3, ""),(2, ""),(1, ""),(4, ""),(1, "")] :: [(Int, String)]- result <- C.produceAndConsume (E.list list) (D.transform (A.distinctBy fst) D.list)- assertEqual "" [(1, ""),(2, ""),(3, ""),(4, "")] result- ,- testCase "Concurrently" $ do- let- list = [1..20000]- produce = E.list list- transform =- A.concurrently 12 $- arr (\ x -> H.randomRIO (0, 100) >>= threadDelay >> return x) >>>- A.executeIO- consume = D.transform transform D.list- result <- C.produceAndConsume produce consume- assertBool "Is dispersed" (list /= result)- assertEqual "Contains no duplicates" 0 (length result - length (nub result))- assertEqual "Equals the original once sorted" list (sort result)- ,- testProperty "Line" $ \ chunks ->- let- expected =- mconcat chunks- actual =- unsafePerformIO (C.produceAndConsume produce consume)- where- produce =- E.list chunks- consume =- rmap (mconcat . intersperse "\n") $- D.transform A.extractLines D.list- in expected === actual- ,- testProperty "takeWhile" $ \ (list :: [Int]) ->- let listPart = takeWhile odd list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndTransformAndConsume prod (A.takeWhile odd) D.list)- M.assert (res == listPart)- ,- testProperty "mapFilter" $ \ (list :: [Int]) ->- let in2MaybeOut input =- if input `mod` 4 == 0- then Just $ input `mod` 4- else Nothing- filteredList = map fromJust . filter (/= Nothing) . map in2MaybeOut $ list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndTransformAndConsume prod (A.mapFilter in2MaybeOut) D.list)- M.assert (res == filteredList)- ,- testProperty "filter" $ \ (list :: [Int]) ->- let filteredList = filter even list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndTransformAndConsume prod (A.filter even) D.list)- M.assert (res == filteredList)- ]--parsingPotoki :: TestTree-parsingPotoki =- testGroup "Parsing" $- [- testCase "Sample 1" $ do- let parser = B.double <* B.char ','- transform = arr (either (const Nothing) Just) >>> A.just >>> A.parseBytes parser- produce = E.transform transform (E.fileBytes "samples/1")- result <- C.produceAndConsume produce D.count- assertEqual "" 4350 result- ,- testCase "Sample 1 greedy" $ do- let parser = B.sepBy B.double (B.char ',')- transform = arr (either (const Nothing) Just) >>> A.just >>> A.parseBytes parser- produce = E.transform transform (E.fileBytes "samples/1")- result <- C.produceAndConsume produce D.list- assertEqual "" [Right 4350] (fmap (fmap length) result)- ,- testCase "Split chunk" $- let- produce = E.list ["1", "2", "3"]- parser = B.anyChar- transform = A.parseBytes parser >>> arr (either (const Nothing) Just) >>> A.just- consume = D.transform transform D.count- in do- assertEqual "" 3 =<< C.produceAndConsume produce consume- ]--consumePotoki =- testGroup "Consume" $- [- testProperty "count" $ \ (list :: [Int]) ->- let n = length list- in monadicIO $ do- let prod = E.list list- len <- run (C.produceAndConsume prod D.count)- M.assert (len == n)- ,- testProperty "sum" $ \ (list :: [Int]) ->- let n = sum list- in monadicIO $ do- let prod = E.list list- len <- run (C.produceAndConsume prod D.sum)- M.assert (len == n)- ,- testProperty "head" $ \ (list :: [Int]) ->- let el = if null list then Nothing else (Just (head list))- in monadicIO $ do- let prod = E.list list- he <- run (C.produceAndConsume prod D.head)- M.assert (he == el)- ,- testProperty "last" $ \ (list :: [Int]) ->- let el = if null list then Nothing else (Just (last list))- in monadicIO $ do- let prod = E.list list- he <- run (C.produceAndConsume prod D.last)- M.assert (he == el)- ,- testProperty "list" $ \ (list :: [Int]) ->- monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod D.list)- M.assert (res == list)- ,- testProperty "reverseList" $ \ (list :: [Int]) ->- let revList = reverse list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod D.reverseList)- M.assert (res == revList)- ,- testProperty "vector" $ \ (list :: [Int]) ->- let vec = G.fromList list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod D.vector)- M.assert (res == vec)- ,- testProperty "concat" $ \ (list :: [[Int]]) ->- let con = concat list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod D.concat)- M.assert (res == con)- ,- testProperty "fold" $ \ (list :: [Int], fun :: (Fun (Int, Int) Int), first :: Int) ->- let f = applyFun2 fun- fol = foldl' f first list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod (D.fold (Fl.Fold f first id)))- M.assert (res == fol)- ,- testProperty "foldInIO" $ \ (list :: [Int]) ->- let fin = sum list- in monadicIO $ do- let prod = E.list list- res <- run $ do- sumVar <- newIORef 0- (C.produceAndConsume prod (D.foldInIO (Fl.FoldM (\_ a -> modifyIORef' sumVar (a+)) (pure ()) (\_ -> readIORef sumVar)) ) )- M.assert (res == fin)- ,- testProperty "folding" $ \ (list :: [Int], fun :: (Fun (Int, Int) Int), first :: Int) ->- let f = applyFun2 fun- fol = foldl' f first list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod (D.folding (Fl.Fold f first id) (D.sum) ))- a <- run (C.produceAndConsume prod D.sum)- M.assert (res == (fol, a))- ,- testProperty "foldingInIO" $ \ (list :: [Int]) ->- let fol = sum list- in monadicIO $ do- let prod = E.list list- res <- run $ do- sumVar <- newIORef 0- (C.produceAndConsume prod (D.foldingInIO (Fl.FoldM (\_ a -> modifyIORef' sumVar (a+)) (pure ()) (\_ -> readIORef sumVar)) (D.sum) ))- a <- run (C.produceAndConsume prod D.sum)- M.assert (res == (fol, a))- ,- testProperty "execState" $ \ (list :: [Int]) ->- let f = modify' . (+)- resL = sum list- in monadicIO $ do- let prod = E.list list- res <- run (C.produceAndConsume prod (D.execState f 0))- M.assert (res == resL)- ,- testProperty "Choice consume right'" $ \ (list :: [Either Bool Int]) ->- let n = sum <$> sequence list- in monadicIO $ do- let prod = E.list list- len <- run (C.produceAndConsume prod $ right' D.sum)- M.assert (len == n)- ]-
− tests/Transform.hs
@@ -1,178 +0,0 @@-module Transform where--import Prelude hiding (first, second)-import Control.Arrow-import Test.QuickCheck.Instances-import Test.Tasty-import Test.Tasty.Runners-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-import qualified Potoki.Core.IO as C-import qualified Potoki.Core.Consume as D-import qualified Potoki.Core.Transform as A-import qualified Potoki.Core.Produce as E-import qualified Data.Attoparsec.ByteString.Char8 as B-import qualified Data.ByteString as F-import qualified Data.Vector as G-import qualified System.Random as H--transform :: TestTree-transform =- testGroup "Transform" $- [- transformProduce- ,- transformChoice- ,- transformArrowLaws- ]--transformProduce =- testGroup "Produce" $- [- testCase "1" $ do- let- list = [1, 2, 3] :: [Int]- result <- C.produceAndTransformAndConsume- (E.list list)- (A.produce (E.list . \ n -> flip replicate n n))- (D.list)- assertEqual "" [1, 2, 2, 3, 3, 3] result- ,- testCase "2" $ do- let- list = [1, 2, 3] :: [Int]- result <- C.produceAndTransformAndConsume- (E.list list)- (A.produce (E.list . \ n -> [(n, n)]))- (D.list)- assertEqual "" [(1, 1), (2, 2), (3, 3)] result- ,- testCase "3" $ do- let- list = [1, 2, 3] :: [Int]- result <- C.produceAndTransformAndConsume- (E.list list)- (A.produce (E.list . \ n -> [n, n]))- (D.list)- assertEqual "" [1, 1, 2, 2, 3, 3] result- ]--transformChoice =- testGroup "Choice" $- [- testCase "1" $ do- let- list = [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3]- transform = left' id- result <- C.produceAndTransformAndConsume (E.list list) transform D.list- assertEqual "" [Left 1, Left 2, Right 'z', Left 2, Right 'a', Left 1, Right 'b', Left 0, Right 'x', Left 4, Left 3] result- ,- testCase "2" $ do- let- list = [Left 1, Left 2, Right 'z', Right 'a', Right 'b', Left 0, Right 'x', Left 4, Left 3]- transform = right' (A.consume D.list)- result <- C.produceAndTransformAndConsume (E.list list) transform D.list- assertEqual "" [Left 1, Left 2, Right "zab", Left 0, Right "x", Left 4, Left 3] result- ,- testCase "3" $ do- let- list = [Left 4, Right 'z', Right 'a', Left 3, Right 'b', Left 0, Left 1, Right 'x', Left 4, Left 3]- transform = left' (A.consume D.list)- result <- C.produceAndTransformAndConsume (E.list list) transform D.list- assertEqual "" [Left [4], Right 'z', Right 'a', Left [3], Right 'b', Left [0, 1], Right 'x', Left [4, 3]] result- ]--transformArrowLaws =- testGroup "Arrow laws"- [- testGroup "Strong"- [- testCase "1" $ do- let- input = [(1,'a'),(2,'b'),(3,'c'),(4,'d')]- transform = first transform1- result <- C.produceAndTransformAndConsume (E.list input) transform D.list- assertEqual "" [(6,'c'),(4,'d')] result- ,- testCase "Lack of elements" $ do- let- input = [(1,'a'),(2,'b')]- transform = first transform1- result <- C.produceAndTransformAndConsume (E.list input) transform D.list- assertEqual "" [(3,'b')] result- ]- ,- transformProperty "arr id = id"- (arr id :: A.Transform Int Int)- id- ,- transformProperty "arr (f >>> g) = arr f >>> arr g"- (arr (f >>> g))- (arr f >>> arr g)- ,- transformProperty "first (arr f) = arr (first f)"- (first (arr f) :: A.Transform (Int, Char) (Int, Char))- (arr (first f))- ,- transformProperty "first (f >>> g) = first f >>> first g"- (first (transform1 >>> transform2) :: A.Transform (Int, Char) (Int, Char))- (first (transform1) >>> first (transform2))- ,- transformProperty "first f >>> arr fst = arr fst >>> f"- (first transform1 >>> arr fst :: A.Transform (Int, Char) Int)- (arr fst >>> transform1)- ,- transformProperty "first f >>> arr (id *** g) = arr (id *** g) >>> first f"- (first transform1 >>> arr (id *** g))- (arr (id *** g) >>> first transform1)- ,- transformProperty "first (first f) >>> arr assoc = arr assoc >>> first f"- (first (first transform1) >>> arr assoc :: A.Transform ((Int, Char), Double) (Int, (Char, Double)))- (arr assoc >>> first transform1)- ,- transformProperty "left (arr f) = arr (left f)"- (left (arr f) :: A.Transform (Either Int Char) (Either Int Char))- (arr (left f))- ,- transformProperty "left (f >>> g) = left f >>> left g"- (left (transform1 >>> transform2) :: A.Transform (Either Int Char) (Either Int Char))- (left (transform1) >>> left (transform2))- ,- transformProperty "f >>> arr Left = arr Left >>> left f"- (transform1 >>> arr Left :: A.Transform Int (Either Int Char))- (arr Left >>> left transform1)- ,- transformProperty "left f >>> arr (id +++ g) = arr (id +++ g) >>> left f"- (left transform1 >>> arr (id +++ g))- (arr (id +++ g) >>> left transform1)- ,- transformProperty "left (left f) >>> arr assocsum = arr assocsum >>> left f"- (left (left transform1) >>> arr assocsum :: A.Transform (Either (Either Int Char) Double) (Either Int (Either Char Double)))- (arr assocsum >>> left transform1)- ,- transformProperty "left (left (arr f)) >>> arr assocsum = arr assocsum >>> left (arr f)"- (left (left (arr f)) >>> arr assocsum :: A.Transform (Either (Either Int Char) Double) (Either Int (Either Char Double)))- (arr assocsum >>> left (arr f))- ]- where- f = (+24) :: Int -> Int- g = (*3) :: Int -> Int- transform1 = A.consume (D.transform (A.take 3) D.sum) :: A.Transform Int Int- transform2 = A.consume (D.transform (A.take 4) D.sum) :: A.Transform Int Int- assoc ((a,b),c) = (a,(b,c))- assocsum (Left (Left x)) = Left x- assocsum (Left (Right y)) = Right (Left y)- assocsum (Right z) = Right (Right z)--transformProperty ::- (Arbitrary input, Show input, Eq output, Show output) =>- String -> A.Transform input output -> A.Transform input output -> TestTree-transformProperty name leftTransform rightTransform =- testProperty name property- where- property list =- transform leftTransform === transform rightTransform- where- transform transform =- unsafePerformIO (C.produceAndTransformAndConsume (E.list list) transform D.list)