packages feed

potoki 0.11.1 → 0.11.2

raw patch · 10 files changed

+527/−404 lines, 10 filesdep +ptr

Dependencies added: ptr

Files

library/Potoki/Prelude.hs view
@@ -3,6 +3,7 @@   module Exports,   ioChunkSize,   textString,+  unsnoc, ) where @@ -54,3 +55,18 @@ textString :: Text -> String textString =   A.unpack++{-# INLINABLE unsnoc #-}+unsnoc :: [a] -> Maybe ([a], a)+unsnoc list =+  case process list of+    (init, lastMaybe) -> fmap (\ last -> (init, last)) lastMaybe+  where+    process list =+      case list of+        head : tail -> case tail of+          [] -> ([], Just head)+          _ -> case process tail of+            (init, lastMaybe) -> (head : init, lastMaybe)+        _ -> ([], Nothing)+
library/Potoki/Transform.hs view
@@ -16,15 +16,17 @@   vector,   distinctBy,   distinct,-  builderChunks,   executeIO,   mapInIO,-  runState,-  execState,-  evalState,+  -- * ByteString+  module Potoki.Transform.ByteString,+  -- * State+  R.runState,+  R.execState,+  R.evalState,   -- * Parsing-  parseBytes,-  parseText,+  A.parseBytes,+  A.parseText,   -- * Concurrency   N.bufferize,   N.concurrently,@@ -38,277 +40,11 @@ ) where -import Potoki.Prelude hiding (take, takeWhile, filter, drop) import Potoki.Core.Transform-import qualified Potoki.Fetch as A-import qualified Potoki.Core.Fetch as A-import qualified Potoki.Core.IO as G-import qualified Potoki.Core.Produce as H-import qualified Data.Attoparsec.ByteString as K-import qualified Data.Attoparsec.Text as L-import qualified Data.Attoparsec.Types as M-import qualified Data.HashSet as C-import qualified Data.ByteString.Builder as E-import qualified Data.ByteString.Lazy as F-import qualified Data.ByteString as J-import qualified Data.Text.IO as Q-import qualified Data.Vector as P-import qualified System.Directory as I-import qualified Control.Concurrent.Chan.Unagi.Bounded as B-import qualified Control.Monad.Trans.State.Strict as O+import Potoki.Transform.Basic+import Potoki.Transform.FileIO+import Potoki.Transform.ByteString+import qualified Potoki.Transform.Attoparsec as A import qualified Potoki.Transform.Concurrency as N---{-# INLINE mapFilter #-}-mapFilter :: (input -> Maybe output) -> Transform input output-mapFilter mapping =-  Transform (pure . A.mapFilter mapping)--{-# INLINE filter #-}-filter :: (input -> Bool) -> Transform input input-filter predicate =-  Transform (pure . A.filter predicate)--{-# INLINE just #-}-just :: Transform (Maybe input) input-just =-  Transform (pure . A.just)--{-# INLINE takeWhile #-}-takeWhile :: (input -> Bool) -> Transform input input-takeWhile predicate =-  Transform (pure . A.takeWhile predicate)--{-# INLINE drop #-}-drop :: Int -> Transform input input-drop amount =-  Transform $ \ (A.Fetch fetchIO) -> do-    countRef <- newIORef amount-    return $ A.Fetch $ \ nil just -> fix $ \ loop -> do-      count <- readIORef countRef-      if count > 0-        then do-          writeIORef countRef $! pred count-          loop-        else fetchIO nil just--{-# INLINE mapWithParseResult #-}-mapWithParseResult :: forall input parsed. (Monoid input, Eq input) => (input -> M.IResult input parsed) -> Transform input (Either Text parsed)-mapWithParseResult inputToResult =-  Transform $ \ inputFetch ->-  do-    unconsumedRef <- newIORef mempty-    finishedRef <- newIORef False-    return (A.Fetch (fetchParsed inputFetch finishedRef unconsumedRef))-  where-    fetchParsed :: A.Fetch input -> IORef Bool -> IORef input -> forall x. x -> (Either Text parsed -> x) -> IO x-    fetchParsed (A.Fetch inputFetchIO) finishedRef unconsumedRef nil just =-      do-        finished <- readIORef finishedRef-        if finished-          then return nil-          else do-            unconsumed <- readIORef unconsumedRef-            if unconsumed == mempty-              then-                join $ inputFetchIO-                  (return nil)-                  (\input -> do-                    if input == mempty-                      then return nil-                      else matchResult (inputToResult input))-              else do-                writeIORef unconsumedRef mempty-                matchResult (inputToResult unconsumed)-      where-        matchResult =-          \case-            M.Partial inputToResult ->-              consume inputToResult-            M.Done unconsumed parsed ->-              do-                writeIORef unconsumedRef unconsumed-                return (just (Right parsed))-            M.Fail unconsumed contexts message ->-              do-                writeIORef unconsumedRef unconsumed-                writeIORef finishedRef True-                return (just (Left resultMessage))-              where-                resultMessage =-                  if null contexts-                    then fromString message-                    else fromString (showString (intercalate " > " contexts) (showString ": " message))-        consume inputToResult =-          join $ inputFetchIO-            (do-              writeIORef finishedRef True-              matchResult (inputToResult mempty))-            (\input -> do-              when (input == mempty) (writeIORef finishedRef True)-              matchResult (inputToResult input))--{-|-Lift an Attoparsec ByteString parser.--}-{-# INLINE parseBytes #-}-parseBytes :: K.Parser parsed -> Transform ByteString (Either Text parsed)-parseBytes parser =-  mapWithParseResult (K.parse parser)--{-|-Lift an Attoparsec Text parser.--}-{-# INLINE parseText #-}-parseText :: L.Parser parsed -> Transform Text (Either Text parsed)-parseText parser =-  mapWithParseResult (L.parse parser)--{-# INLINE mapInIO #-}-mapInIO :: (a -> IO b) -> Transform a b-mapInIO io =-  Transform $ \ (A.Fetch fetch) ->-  return $ A.Fetch $ \ nil just ->-  join $ fetch (return nil) $ (fmap . fmap) just io--{-# INLINE deleteFile #-}-deleteFile :: Transform FilePath (Either IOException ())-deleteFile =-  mapInIO (try . I.removeFile)--{-# INLINE appendBytesToFile #-}-appendBytesToFile :: Transform (FilePath, ByteString) (Either IOException ())-appendBytesToFile =-  mapInIO $ \ (path, bytes) ->-  try $ -  withFile path AppendMode $ \ handle -> -  J.hPut handle bytes--{-# INLINABLE writeTextToFile #-}-writeTextToFile :: Transform (FilePath, Text) (Either IOException ())-writeTextToFile =-  mapInIO $ \ (path, text) ->-  try $ -  Q.writeFile path text--{-# INLINE distinctBy #-}-distinctBy :: (Eq comparable, Hashable comparable) => (element -> comparable) -> Transform element element-distinctBy f =-  Transform $ \ (A.Fetch fetch) -> do-    stateRef <- newIORef mempty-    return $ A.Fetch $ \ nil just -> fix $ \ loop -> join $ fetch (return nil) $ \ !input -> do-      let comparable = f input-      !set <- readIORef stateRef-      if C.member comparable set-        then loop-        else do-          writeIORef stateRef $! C.insert comparable set-          return (just input)--{-# INLINE distinct #-}-distinct :: (Eq element, Hashable element) => Transform element element-distinct = distinctBy id--{-# INLINE builderChunks #-}-builderChunks :: Transform E.Builder ByteString-builderChunks =-  produce (H.list . F.toChunks . E.toLazyByteString)--{-# INLINE ioTransform #-}-ioTransform :: IO (Transform a b) -> Transform a b-ioTransform io =-  Transform $ \ fetch -> do-    Transform transformIO <- io-    transformIO fetch--{-|-Notice that you can control the emission of output of each step-by producing a list of outputs and then composing the transform with-the "list" transform.--}-{-# INLINE runState #-}-runState :: (a -> O.State s b) -> s -> Transform a (s, b)-runState stateFn initialState =-  Transform $ \ (A.Fetch fetchIO) -> do-    stateRef <- newIORef initialState-    return $ A.Fetch $ \ nil just -> do-      let-        nilIO =-          return nil-        justIO input =-          do-            currentState <- readIORef stateRef-            case O.runState (stateFn input) currentState of-              (output, newState) -> do-                writeIORef stateRef newState-                return (just (newState, output))-        in join (fetchIO nilIO justIO)--{-# INLINE evalState #-}-evalState :: (a -> O.State s b) -> s -> Transform a b-evalState stateFn initialState =-  runState stateFn initialState >>> arr snd---{-# INLINE execState #-}-execState :: (a -> O.State s b) -> s -> Transform a s-execState stateFn initialState =-  runState stateFn initialState >>> arr fst-  --{-# INLINE list #-}-list :: Transform [a] a-list =-  Transform $ \ (A.Fetch fetchListIO) -> do-    bufferRef <- newIORef []-    return $ A.Fetch $ \ nil just -> do-      buffer <- readIORef bufferRef-      case buffer of-        head : tail -> do-          writeIORef bufferRef tail-          return (just head)-        _ ->-          let-            fetchElementIO =-              let-                nilIO =-                  return nil-                justIO input =-                  case input of-                    head : tail -> do-                      writeIORef bufferRef tail-                      return (just head)-                    _ -> do-                      writeIORef bufferRef []-                      return nil-                in join (fetchListIO nilIO justIO)-            in fetchElementIO--vector :: Transform (Vector a) a-vector =-  Transform $ \ (A.Fetch fetchVectorIO) -> do-    indexRef <- newIORef 0-    vectorRef <- newIORef mempty-    return $ A.Fetch $ \ nil just -> fix $ \ loop -> do-      vector <- readIORef vectorRef-      index <- readIORef indexRef-      if index < P.length vector-        then do-          writeIORef indexRef (succ index)-          return (just (P.unsafeIndex vector index))-        else join $ fetchVectorIO (return nil) $ \ vector -> do-          writeIORef vectorRef vector-          writeIORef indexRef 0-          loop+import qualified Potoki.Transform.State as R -{-|-Useful for debugging--}-traceWithCounter :: (Int -> String) -> Transform a a-traceWithCounter show =-  ioTransform $ do-    counter <- newIORef 0-    return $ mapInIO $ \ x -> do-      n <- atomicModifyIORef' counter (\ n -> (succ n, n))-      putStrLn (show n)-      return x
+ library/Potoki/Transform/Attoparsec.hs view
@@ -0,0 +1,84 @@+module Potoki.Transform.Attoparsec+where++import Potoki.Prelude hiding (take, takeWhile, filter, drop)+import Potoki.Core.Transform+import Potoki.Transform.Basic+import qualified Potoki.Fetch as A+import qualified Potoki.Core.Fetch as A+import qualified Data.Attoparsec.ByteString as K+import qualified Data.Attoparsec.Text as L+import qualified Data.Attoparsec.Types as M+++{-# INLINE mapWithParseResult #-}+mapWithParseResult :: forall input parsed. (Monoid input, Eq input) => (input -> M.IResult input parsed) -> Transform input (Either Text parsed)+mapWithParseResult inputToResult =+  Transform $ \ inputFetch ->+  do+    unconsumedRef <- newIORef mempty+    finishedRef <- newIORef False+    return (A.Fetch (fetchParsed inputFetch finishedRef unconsumedRef))+  where+    fetchParsed :: A.Fetch input -> IORef Bool -> IORef input -> forall x. x -> (Either Text parsed -> x) -> IO x+    fetchParsed (A.Fetch inputFetchIO) finishedRef unconsumedRef nil just =+      do+        finished <- readIORef finishedRef+        if finished+          then return nil+          else do+            unconsumed <- readIORef unconsumedRef+            if unconsumed == mempty+              then+                join $ inputFetchIO+                  (return nil)+                  (\input -> do+                    if input == mempty+                      then return nil+                      else matchResult (inputToResult input))+              else do+                writeIORef unconsumedRef mempty+                matchResult (inputToResult unconsumed)+      where+        matchResult =+          \case+            M.Partial inputToResult ->+              consume inputToResult+            M.Done unconsumed parsed ->+              do+                writeIORef unconsumedRef unconsumed+                return (just (Right parsed))+            M.Fail unconsumed contexts message ->+              do+                writeIORef unconsumedRef unconsumed+                writeIORef finishedRef True+                return (just (Left resultMessage))+              where+                resultMessage =+                  if null contexts+                    then fromString message+                    else fromString (showString (intercalate " > " contexts) (showString ": " message))+        consume inputToResult =+          join $ inputFetchIO+            (do+              writeIORef finishedRef True+              matchResult (inputToResult mempty))+            (\input -> do+              when (input == mempty) (writeIORef finishedRef True)+              matchResult (inputToResult input))++{-|+Lift an Attoparsec ByteString parser.+-}+{-# INLINE parseBytes #-}+parseBytes :: K.Parser parsed -> Transform ByteString (Either Text parsed)+parseBytes parser =+  mapWithParseResult (K.parse parser)++{-|+Lift an Attoparsec Text parser.+-}+{-# INLINE parseText #-}+parseText :: L.Parser parsed -> Transform Text (Either Text parsed)+parseText parser =+  mapWithParseResult (L.parse parser)
+ library/Potoki/Transform/Basic.hs view
@@ -0,0 +1,133 @@+module Potoki.Transform.Basic+where++import Potoki.Prelude hiding (take, takeWhile, filter, drop)+import Potoki.Core.Transform+import qualified Potoki.Fetch as A+import qualified Potoki.Core.Fetch as A+import qualified Data.HashSet as C+import qualified Data.Vector as P+++{-# INLINE mapFilter #-}+mapFilter :: (input -> Maybe output) -> Transform input output+mapFilter mapping =+  Transform (pure . A.mapFilter mapping)++{-# INLINE filter #-}+filter :: (input -> Bool) -> Transform input input+filter predicate =+  Transform (pure . A.filter predicate)++{-# INLINE just #-}+just :: Transform (Maybe input) input+just =+  Transform (pure . A.just)++{-# INLINE takeWhile #-}+takeWhile :: (input -> Bool) -> Transform input input+takeWhile predicate =+  Transform (pure . A.takeWhile predicate)++{-# INLINE drop #-}+drop :: Int -> Transform input input+drop amount =+  Transform $ \ (A.Fetch fetchIO) -> do+    countRef <- newIORef amount+    return $ A.Fetch $ \ nil just -> fix $ \ loop -> do+      count <- readIORef countRef+      if count > 0+        then do+          writeIORef countRef $! pred count+          loop+        else fetchIO nil just++{-# INLINE list #-}+list :: Transform [a] a+list =+  Transform $ \ (A.Fetch fetchListIO) -> do+    bufferRef <- newIORef []+    return $ A.Fetch $ \ nil just -> do+      buffer <- readIORef bufferRef+      case buffer of+        head : tail -> do+          writeIORef bufferRef tail+          return (just head)+        _ ->+          let+            fetchElementIO =+              let+                nilIO =+                  return nil+                justIO input =+                  case input of+                    head : tail -> do+                      writeIORef bufferRef tail+                      return (just head)+                    _ -> do+                      writeIORef bufferRef []+                      return nil+                in join (fetchListIO nilIO justIO)+            in fetchElementIO++{-# INLINABLE vector #-}+vector :: Transform (Vector a) a+vector =+  Transform $ \ (A.Fetch fetchVectorIO) -> do+    indexRef <- newIORef 0+    vectorRef <- newIORef mempty+    return $ A.Fetch $ \ nil just -> fix $ \ loop -> do+      vector <- readIORef vectorRef+      index <- readIORef indexRef+      if index < P.length vector+        then do+          writeIORef indexRef (succ index)+          return (just (P.unsafeIndex vector index))+        else join $ fetchVectorIO (return nil) $ \ vector -> do+          writeIORef vectorRef vector+          writeIORef indexRef 0+          loop++{-# INLINE distinctBy #-}+distinctBy :: (Eq comparable, Hashable comparable) => (element -> comparable) -> Transform element element+distinctBy f =+  Transform $ \ (A.Fetch fetch) -> do+    stateRef <- newIORef mempty+    return $ A.Fetch $ \ nil just -> fix $ \ loop -> join $ fetch (return nil) $ \ !input -> do+      let comparable = f input+      !set <- readIORef stateRef+      if C.member comparable set+        then loop+        else do+          writeIORef stateRef $! C.insert comparable set+          return (just input)++{-# INLINE distinct #-}+distinct :: (Eq element, Hashable element) => Transform element element+distinct = distinctBy id++{-# INLINE mapInIO #-}+mapInIO :: (a -> IO b) -> Transform a b+mapInIO io =+  Transform $ \ (A.Fetch fetch) ->+  return $ A.Fetch $ \ nil just ->+  join $ fetch (return nil) $ (fmap . fmap) just io++{-# INLINE ioTransform #-}+ioTransform :: IO (Transform a b) -> Transform a b+ioTransform io =+  Transform $ \ fetch -> do+    Transform transformIO <- io+    transformIO fetch++{-|+Useful for debugging+-}+traceWithCounter :: (Int -> String) -> Transform a a+traceWithCounter show =+  ioTransform $ do+    counter <- newIORef 0+    return $ mapInIO $ \ x -> do+      n <- atomicModifyIORef' counter (\ n -> (succ n, n))+      putStrLn (show n)+      return x
+ library/Potoki/Transform/ByteString.hs view
@@ -0,0 +1,61 @@+module Potoki.Transform.ByteString+where++import Potoki.Prelude hiding (filter)+import Potoki.Core.Transform+import Potoki.Transform.Basic+import Potoki.Transform.State+import qualified Potoki.Fetch as A+import qualified Potoki.Core.Fetch as A+import qualified Potoki.Core.Produce as H+import qualified Ptr.Poking as C+import qualified Ptr.ByteString as D+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as E+import qualified Data.ByteString.Lazy as F+import qualified Control.Monad.Trans.State.Strict as O+++{-# INLINE builderChunks #-}+builderChunks :: Transform E.Builder ByteString+builderChunks =+  produce (H.list . F.toChunks . E.toLazyByteString)++{-|+Convert freeform bytestring chunks into chunks,+which are strictly separated by newline no matter how long they may be.+-}+extractLines :: Transform ByteString ByteString+extractLines =+  lineList >>> filter (not . null) >>> list+  -- lineList >>> list+  where+    lineList =+      Transform $ \ (A.Fetch fetchIO) ->+      do+        stateRef <- newIORef Nothing+        return $ A.Fetch $ \ nil just -> join $ fetchIO+          (do+            state <- readIORef stateRef+            case state of+              Just poking -> do+                writeIORef stateRef Nothing+                return (just [D.poking poking])+              Nothing -> return nil)+          (\ chunk ->+            case B.split 10 chunk of+              firstInput : tail -> do+                state <- readIORef stateRef+                let+                  newPoking =+                    fold state <> C.bytes firstInput+                  in case unsnoc tail of+                    Just (init, last) ->+                      do+                        writeIORef stateRef (Just (C.bytes last))+                        return (just (D.poking newPoking : init))+                    Nothing ->+                      do+                        writeIORef stateRef (Just newPoking)+                        return (just [])+              _ -> return (just []))
+ library/Potoki/Transform/FileIO.hs view
@@ -0,0 +1,30 @@+module Potoki.Transform.FileIO+where++import Potoki.Prelude hiding (take, takeWhile, filter, drop)+import Potoki.Core.Transform+import Potoki.Transform.Basic+import qualified Data.ByteString as J+import qualified Data.Text.IO as Q+import qualified System.Directory as I+++{-# INLINE deleteFile #-}+deleteFile :: Transform FilePath (Either IOException ())+deleteFile =+  mapInIO (try . I.removeFile)++{-# INLINE appendBytesToFile #-}+appendBytesToFile :: Transform (FilePath, ByteString) (Either IOException ())+appendBytesToFile =+  mapInIO $ \ (path, bytes) ->+  try $ +  withFile path AppendMode $ \ handle -> +  J.hPut handle bytes++{-# INLINABLE writeTextToFile #-}+writeTextToFile :: Transform (FilePath, Text) (Either IOException ())+writeTextToFile =+  mapInIO $ \ (path, text) ->+  try $ +  Q.writeFile path text
+ library/Potoki/Transform/State.hs view
@@ -0,0 +1,43 @@+module Potoki.Transform.State+where++import Potoki.Prelude+import Potoki.Core.Transform+import qualified Potoki.Fetch as A+import qualified Potoki.Core.Fetch as A+import qualified Data.ByteString as B+import qualified Control.Monad.Trans.State.Strict as O+++{-|+Notice that you can control the emission of output of each step+by producing a list of outputs and then composing the transform with+the "list" transform.+-}+{-# INLINE runState #-}+runState :: (a -> O.State s b) -> s -> Transform a (s, b)+runState stateFn initialState =+  Transform $ \ (A.Fetch fetchIO) -> do+    stateRef <- newIORef initialState+    return $ A.Fetch $ \ nil just -> do+      let+        nilIO =+          return nil+        justIO input =+          do+            currentState <- readIORef stateRef+            case O.runState (stateFn input) currentState of+              (output, newState) -> do+                writeIORef stateRef newState+                return (just (newState, output))+        in join (fetchIO nilIO justIO)++{-# INLINE evalState #-}+evalState :: (a -> O.State s b) -> s -> Transform a b+evalState stateFn initialState =+  runState stateFn initialState >>> arr snd++{-# INLINE execState #-}+execState :: (a -> O.State s b) -> s -> Transform a s+execState stateFn initialState =+  runState stateFn initialState >>> arr fst
potoki.cabal view
@@ -1,7 +1,7 @@ name:   potoki version:-  0.11.1+  0.11.2 synopsis:   Simple streaming in IO description:@@ -75,7 +75,12 @@   other-modules:     Potoki.Fetch     Potoki.Prelude+    Potoki.Transform.Attoparsec+    Potoki.Transform.Basic+    Potoki.Transform.ByteString     Potoki.Transform.Concurrency+    Potoki.Transform.FileIO+    Potoki.Transform.State   build-depends:     attoparsec >=0.13 && <0.15,     base >=4.7 && <5,@@ -86,17 +91,18 @@     hashable >=1 && <2,     potoki-core >=1.5 && <1.6,     profunctors >=5.2 && <6,+    ptr >=0.16.2 && <0.17,     text >=1 && <2,     transformers >=0.5 && <0.6,     unagi-chan >=0.4 && <0.5,     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+    test   main-is:     Main.hs   default-extensions:
+ test/Main.hs view
@@ -0,0 +1,138 @@+module Main 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.IO as C+import qualified Potoki.Consume as D+import qualified Potoki.Transform as A+import qualified Potoki.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+++main =+  defaultMain $+  testGroup "All tests" $+  [+    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+    ,+    transform+    ,+    parsing+  ]++transform :: TestTree+transform =+  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+  ]++parsing :: TestTree+parsing =+  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+  ]
− tests/Main.hs 
@@ -1,124 +0,0 @@-module Main 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.IO as C-import qualified Potoki.Consume as D-import qualified Potoki.Transform as A-import qualified Potoki.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---main =-  defaultMain $-  testGroup "All tests" $-  [-    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-    ,-    transform-    ,-    parsing-  ]--transform :: TestTree-transform =-  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)-  ]--parsing :: TestTree-parsing =-  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-  ]