packages feed

potoki-core 2 → 2.1

raw patch · 8 files changed

+610/−309 lines, 8 filesdep +ilistdep −base-preludedep ~foldldep ~tastydep ~tasty-hunit

Dependencies added: ilist

Dependencies removed: base-prelude

Dependency ranges changed: foldl, tasty, tasty-hunit, tasty-quickcheck

Files

library/Potoki/Core/Consume.hs view
@@ -209,7 +209,6 @@   Consume $ \ fetch ->   try $ withFile path WriteMode $ \ handleVal ->   do-    hSetBuffering handleVal NoBuffering     L.fetchAndHandleAll fetch (return ()) (C.hPut handleVal)  {-|@@ -224,7 +223,6 @@   Consume $ \ fetch ->   try $ withFile path AppendMode $ \ handleVal ->   do-    hSetBuffering handleVal NoBuffering     L.fetchAndHandleAll fetch (return ()) (C.hPut handleVal)  {-# INLINABLE deleteFiles #-}
library/Potoki/Core/Fetch.hs view
@@ -40,32 +40,11 @@   (<*>) (Fetch leftIO) (Fetch rightIO) =     Fetch ((<*>) <$> leftIO <*> rightIO) -instance Monad Fetch where-  return =-    pure-  (>>=) (Fetch leftIO) rightFetch =-    Fetch $ do-      leftFetching <- leftIO-      case leftFetching of-        Nothing -> return Nothing-        Just leftElement -> case rightFetch leftElement of-          Fetch rightIO -> rightIO- instance Alternative Fetch where   empty =     Fetch (pure Nothing)   (<|>) (Fetch leftIO) (Fetch rightIO) =     Fetch ((<|>) <$> leftIO <*> rightIO)--instance MonadPlus Fetch where-  mzero =-    empty-  mplus =-    (<|>)--instance MonadIO Fetch where-  liftIO io =-    Fetch (fmap Just io)  {-# INLINABLE duplicate #-} duplicate :: Fetch element -> IO (Fetch element, Fetch element)
library/Potoki/Core/Produce.hs view
@@ -43,24 +43,44 @@   return = pure   (>>=) (Produce (Acquire io1)) k2 =     Produce $ Acquire $ do-      (fetch1, release1) <- io1+      (A.Fetch fetch1, release1) <- io1       release2Ref <- newIORef (return ())+      fetch3Var <- newIORef (return Nothing)       let         fetch2 input1 =           case k2 input1 of-            Produce (Acquire io2) ->-              A.ioFetch $ do-                join (readIORef release2Ref)-                (fetch2', release2') <- io2-                writeIORef release2Ref release2'-                return fetch2'+            Produce (Acquire io2) -> do+              join (readIORef release2Ref)+              (A.Fetch fetch2', release2') <- io2+              writeIORef release2Ref release2'+              return fetch2'         release3 =           join (readIORef release2Ref) >> release1-        in return (fetch1 >>= fetch2, release3)+        fetch3 =  do+            res <- readIORef fetch3Var+            mayY <- res+            case mayY of+              Nothing -> do+                mayX <- fetch1+                case mayX of+                  Nothing -> return Nothing+                  Just x -> do+                    fetch2 x >>= writeIORef fetch3Var+                    fetch3+              Just y  -> return $ Just y+      return (A.Fetch fetch3, release3)  instance MonadIO Produce where-  liftIO io =-    Produce (return (liftIO io))+  liftIO io = Produce . liftIO $ do+    refX <- newIORef $ Just io+    let fetch = A.Fetch $ fetchIO refX+          where+            fetchIO ref = do+              elemVal <- readIORef ref+              for elemVal $ \getElement -> do+                  writeIORef ref Nothing+                  getElement+    return fetch  {-# INLINABLE list #-} list :: [input] -> Produce input@@ -188,4 +208,3 @@ infiniteMVar :: MVar element -> Produce element infiniteMVar var =   Produce $ M.Acquire (return (A.infiniteMVar var, return ()))-
library/Potoki/Core/Transform/Concurrency.hs view
@@ -11,12 +11,11 @@ import Potoki.Core.Types import qualified Potoki.Core.Fetch as A import qualified Acquire.Acquire as M+import qualified Control.Concurrent.Chan.Unagi.Bounded as B   {-# INLINE bufferize #-} bufferize :: Int -> Transform element element-bufferize = undefined-{- bufferize size =   Transform $ \ (A.Fetch fetch) -> M.Acquire $ do     (inChan, outChan) <- B.newChan size@@ -25,7 +24,6 @@         Nothing -> B.writeChan inChan Nothing         Just !element -> B.writeChan inChan (Just element) >> doLoop     return $ (A.Fetch $ B.readChan outChan, return ())--}  {-| Identity Transform, which ensures that the inputs are fetched synchronously.
potoki-core.cabal view
@@ -1,7 +1,7 @@ name:   potoki-core version:-  2+  2.1 synopsis:   Low-level components of "potoki" description:@@ -65,7 +65,6 @@     profunctors >=5.2 && <6,     stm >=2.4 && <3,     attoparsec >=0.13 && <0.15,-    base-prelude <2,     bytestring ==0.10.*,     directory >=1.3 && <2,     foldl >=1.3 && <2,@@ -84,20 +83,26 @@     tests   main-is:     Main.hs+  other-modules:+    Potoki+    Transform   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   build-depends:-    -- +    --     potoki-core,     -- testing:     attoparsec,-    tasty >=0.12 && <0.13,-    tasty-quickcheck >=0.9 && <0.10,-    tasty-hunit >=0.9 && <0.10,+    acquire >=0.2 && <0.3,+    tasty >=1.0.1 && <1.2,+    tasty-quickcheck >=0.10 && <0.11,+    tasty-hunit >=0.10 && <0.11,     quickcheck-instances >=0.3.11 && <0.4,     QuickCheck >=2.8.1 && <3,     random >=1.1 && <2,+    foldl >=1.3.7 && <1.4,+    ilist >=0.3.1.0 && <0.4,     --     rerebase >=1.1 && <2
tests/Main.hs view
@@ -3,6 +3,7 @@ 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@@ -11,10 +12,14 @@ 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 =@@ -30,285 +35,151 @@     potoki     ,     transform-  ]--transform =-  testGroup "Transform" $-  [-    transformProduce     ,-    transformChoice+    resourceChecker     ,-    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 "sync resource checker" $ do+      resourceVar <- newIORef Initial+      let produce = syncCheckResource resourceVar+      C.produceAndConsume produce D.sum+      fin <- readIORef resourceVar+      assertEqual "" Released fin     ,-    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 "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     ,-    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+    testProperty "Transform->Produce 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   ] -transformArrowLaws =-  testGroup "Arrow laws"+resourceChecker :: TestTree+resourceChecker =+  testGroup "produce1 >>= produce2" $   [-    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)+    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     ,-    transformProperty "left f >>> arr (id +++ g) = arr (id +++ g) >>> left f"-      (left transform1 >>> arr (id +++ g))-      (arr (id +++ g) >>> left transform1)+    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)     ,-    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)+    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     ,-    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))+    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)   ]-  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+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-    property list =-      transform leftTransform === transform rightTransform-      where-        transform transform =-          unsafePerformIO (C.produceAndTransformAndConsume (E.list list) transform D.list)+    f x Nothing = Just $ Just x+    f _ _       = Just Nothing -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-  ]+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 -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-  ]-  -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-  ]+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 view
@@ -0,0 +1,253 @@+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+  ]++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 view
@@ -0,0 +1,178 @@+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)