potoki 0.6.5 → 2.1.4.1
raw patch · 8 files changed
Files
- LICENSE +1/−1
- library/Potoki/Consume.hs +8/−155
- library/Potoki/Fetch.hs +0/−82
- library/Potoki/Prelude.hs +0/−56
- library/Potoki/Produce.hs +7/−129
- library/Potoki/Transform.hs +32/−222
- potoki.cabal +10/−43
- tests/Main.hs +0/−118
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2017, Nikita Volkov+Copyright (c) 2017, Metrix.AI Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation
library/Potoki/Consume.hs view
@@ -5,12 +5,19 @@ count, sum, head,+ last, list, reverseList,+ vector, concat, fold, foldInIO,+ folding,+ foldingInIO,+ execState,+ writeBytesToStdout, writeBytesToFile,+ writeBytesToFileWithoutBuffering, appendBytesToFile, deleteFiles, printBytes,@@ -18,162 +25,8 @@ printString, parseBytes, parseText,+ concurrently, ) where -import Potoki.Prelude hiding (sum, head, fold, concat) import Potoki.Core.Consume-import qualified Potoki.Core.Fetch as A-import qualified Potoki.Core.Produce as H-import qualified Potoki.Core.Transform as J-import qualified Potoki.Core.IO as L-import qualified Data.ByteString as C-import qualified Data.Attoparsec.ByteString as E-import qualified Data.Attoparsec.Text as F-import qualified Data.Attoparsec.Types as I-import qualified Data.Text.IO as K-import qualified Control.Foldl as D-import qualified System.Directory as G---{-# INLINABLE transform #-}-transform :: J.Transform input output -> Consume output sinkOutput -> Consume input sinkOutput-transform (J.Transform transform) (Consume sink) =- Consume (transform >=> sink)--{-# INLINABLE head #-}-head :: Consume input (Maybe input)-head =- Consume (\ (A.Fetch fetchIO) -> fetchIO Nothing Just)--{-|-A faster alternative to "list",-which however constructs the list in the reverse order.--}-{-# INLINABLE reverseList #-}-reverseList :: Consume input [input]-reverseList =- Consume $ \ (A.Fetch fetchIO) -> build fetchIO []- where- build fetchIO !acc =- join (fetchIO (pure acc) (\ element -> build fetchIO (element : acc)))--{-# INLINABLE count #-}-count :: Consume input Int-count =- Consume $ \ (A.Fetch fetchIO) -> build fetchIO 0- where- build fetchIO !acc =- join (fetchIO (pure acc) (const (build fetchIO (succ acc))))--{-# INLINABLE concat #-}-concat :: Monoid monoid => Consume monoid monoid-concat =- Consume $ \ (A.Fetch fetchIO) -> build fetchIO mempty- where- build fetchIO !acc =- join (fetchIO (pure acc) (\ x -> build fetchIO (mappend acc x)))--{-# INLINABLE processInIO #-}-processInIO :: IO () -> (element -> IO ()) -> Consume element ()-processInIO stop process =- Consume (\ fetch -> L.fetchAndHandleAll fetch stop process)--{-# INLINABLE printBytes #-}-printBytes :: Consume ByteString ()-printBytes =- processInIO (putChar '\n') C.putStr--{-# INLINABLE printText #-}-printText :: Consume Text ()-printText =- processInIO (putChar '\n') K.putStr--{-# INLINABLE printString #-}-printString :: Consume String ()-printString =- processInIO (putChar '\n') putStr--{-|-Overwrite a file.--* Exception-free-* Automatic resource management--}-{-# INLINABLE writeBytesToFile #-}-writeBytesToFile :: FilePath -> Consume ByteString (Either IOException ())-writeBytesToFile path =- Consume $ \ fetch ->- try $ withFile path WriteMode $ \ handle ->- do- hSetBuffering handle NoBuffering- L.fetchAndHandleAll fetch (return ()) (C.hPut handle)--{-|-Append to a file.--* Exception-free-* Automatic resource management--}-{-# INLINABLE appendBytesToFile #-}-appendBytesToFile :: FilePath -> Consume ByteString (Either IOException ())-appendBytesToFile path =- Consume $ \ fetch ->- try $ withFile path AppendMode $ \ handle ->- do- hSetBuffering handle NoBuffering- L.fetchAndHandleAll fetch (return ()) (C.hPut handle)--{-# INLINABLE deleteFiles #-}-deleteFiles :: Consume FilePath (Either IOException ())-deleteFiles =- Consume $ \ fetch ->- try $ L.fetchAndHandleAll fetch (return ()) G.removeFile--{-# INLINABLE fold #-}-fold :: D.Fold input output -> Consume input output-fold (D.Fold step init finish) =- Consume $ \ (A.Fetch fetch) -> build fetch init- where- build fetch !accumulator =- join (fetch (pure (finish accumulator)) (\ !input -> build fetch (step accumulator input)))--{-# INLINABLE foldInIO #-}-foldInIO :: D.FoldM IO input output -> Consume input output-foldInIO (D.FoldM step init finish) =- Consume $ \ (A.Fetch fetch) -> build fetch =<< init- where- build fetch !accumulator =- join (fetch (finish accumulator) (\ !input -> step accumulator input >>= build fetch))--{-# INLINABLE runParseResult #-}-runParseResult :: (Monoid input, Eq input) => (input -> I.IResult input output) -> Consume input (Either Text output)-runParseResult inputToResult =- Consume $ \ (A.Fetch fetchInput) ->- let- consume inputToResult =- join (fetchInput nil just)- where- nil =- just mempty- just !input =- case inputToResult input of- I.Partial newInputToResult -> consume newInputToResult- I.Done _ parsed -> return (Right parsed)- I.Fail _ contexts message -> return (Left resultMessage)- where- resultMessage =- if null contexts- then fromString message- else fromString (showString (intercalate " > " contexts) (showString ": " message))- in consume inputToResult--{-# INLINABLE parseBytes #-}-parseBytes :: E.Parser output -> Consume ByteString (Either Text output)-parseBytes =- runParseResult . E.parse--{-# INLINABLE parseText #-}-parseText :: F.Parser output -> Consume Text (Either Text output)-parseText =- runParseResult . F.parse
− library/Potoki/Fetch.hs
@@ -1,82 +0,0 @@-module Potoki.Fetch-where--import Potoki.Prelude-import Potoki.Core.Fetch-import qualified Data.Attoparsec.Types as I-import qualified Data.Attoparsec.ByteString as K-import qualified Data.Attoparsec.Text as L-import qualified Data.HashMap.Strict as B-import qualified Data.Vector as C-import qualified Data.ByteString as D-import qualified Data.Text as A-import qualified Data.Text.IO as A---{-# INLINABLE handleBytes #-}-handleBytes :: Handle -> Int -> Fetch (Either IOException ByteString)-handleBytes handle chunkSize =- Fetch $ \ nil just -> do- chunk <- try (D.hGetSome handle chunkSize)- case chunk of- Right "" -> return nil- _ -> return (just chunk)--{-# INLINABLE handleText #-}-handleText :: Handle -> Fetch (Either IOException Text)-handleText handle =- Fetch $ \ nil just -> do- chunk <- try (A.hGetChunk handle)- case chunk of- Right "" -> return nil- _ -> return (just chunk)--{-# INLINABLE mapFilter #-}-mapFilter :: (input -> Maybe output) -> Fetch input -> Fetch output-mapFilter mapping (Fetch fetchIO) =- Fetch $ \ nil just ->- fix $ \ loop ->- join $ fetchIO (return nil) $ \ input ->- case mapping input of- Just output -> return (just output)- Nothing -> loop--{-# INLINABLE filter #-}-filter :: (input -> Bool) -> Fetch input -> Fetch input-filter predicate (Fetch fetchIO) =- Fetch $ \ nil just ->- fix $ \ loop ->- join $ fetchIO (return nil) $ \ input ->- if predicate input- then return (just input)- else loop--{-# INLINABLE just #-}-just :: Fetch (Maybe element) -> Fetch element-just (Fetch fetchIO) =- Fetch $ \ nil just ->- fix $ \ loop ->- join $ fetchIO (return nil) $ \ case- Just output -> return (just output)- Nothing -> loop--{-# INLINABLE takeWhile #-}-takeWhile :: (element -> Bool) -> Fetch element -> Fetch element-takeWhile predicate (Fetch fetchIO) =- Fetch $ \ nil just ->- fetchIO nil $ \ input ->- if predicate input- then just input- else nil--{-# INLINABLE infiniteMVar #-}-infiniteMVar :: MVar element -> Fetch element-infiniteMVar var =- Fetch $ \ nil just ->- fmap just (takeMVar var)--{-# INLINABLE finiteMVar #-}-finiteMVar :: MVar (Maybe element) -> Fetch element-finiteMVar var =- Fetch $ \ nil just ->- fmap (maybe nil just) (takeMVar var)
− library/Potoki/Prelude.hs
@@ -1,56 +0,0 @@-module Potoki.Prelude-( - module Exports,- ioChunkSize,- textString,-)-where---- base---------------------------import Data.Functor.Compose as Exports-import System.IO as Exports-import Control.Arrow as Exports (first, second)---- base-prelude---------------------------import BasePrelude as Exports hiding (first, second)---- profunctors---------------------------import Data.Profunctor.Unsafe as Exports-import Data.Profunctor.Choice as Exports-import Data.Profunctor.Strong as Exports---- text---------------------------import Data.Text as Exports (Text)---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- unordered-containers---------------------------import Data.HashMap.Strict as Exports (HashMap)---- vector---------------------------import Data.Vector as Exports (Vector)---- hashable---------------------------import Data.Hashable as Exports (Hashable)------------------------------------------------------------------------------------import qualified Data.Text as A--{-# NOINLINE ioChunkSize #-}-ioChunkSize :: Int-ioChunkSize =- shiftL 2 12--textString :: Text -> String-textString =- A.unpack
library/Potoki/Produce.hs view
@@ -4,143 +4,21 @@ transform, list, vector,+ vectorWithIndices, hashMapRows, fileBytes, fileBytesAtOffset, fileText,+ stdinBytes, directoryContents, finiteMVar, infiniteMVar,+ tbmChan,+ tmChan,+ enumInRange,+ mergeOrdering,+ unfoldr, ) where -import Potoki.Prelude import Potoki.Core.Produce-import qualified Potoki.Fetch as A-import qualified Potoki.Core.Fetch as A-import qualified Potoki.Core.Consume as E-import qualified Potoki.Core.Transform as F-import qualified Data.Attoparsec.Types as I-import qualified Data.Attoparsec.ByteString as K-import qualified Data.Attoparsec.Text as L-import qualified Data.HashMap.Strict as B-import qualified Data.ByteString as D-import qualified Data.Vector as C-import qualified System.Directory as G---{-# INLINE transform #-}-transform :: F.Transform input output -> Produce input -> Produce output-transform (F.Transform transformIO) (Produce produceIO) =- Produce $ do- (fetch, kill) <- produceIO- newFetch <- transformIO fetch- return (newFetch, kill)--{-# INLINE vector #-}-vector :: Vector input -> Produce input-vector vector =- Produce $ do- indexRef <- newIORef 0- let- fetch =- A.Fetch $ \ nil just -> do- index <- readIORef indexRef- writeIORef indexRef $! succ index- return $ case (C.!?) vector index of- Just !input -> just input- Nothing -> nil- in return (fetch, return ())--{-# INLINE hashMapRows #-}-hashMapRows :: HashMap a b -> Produce (a, b)-hashMapRows =- list . B.toList--{-|-Read from a file by path.--* Exception-free-* Automatic resource management--}-{-# INLINABLE fileBytes #-}-fileBytes :: FilePath -> Produce (Either IOException ByteString)-fileBytes path =- Produce $ do- handleOpened <- try (openBinaryFile path ReadMode)- case handleOpened of- Right handle ->- return (A.handleBytes handle ioChunkSize, catchIOError (hClose handle) (const (return ())))- Left exception ->- return (pure (Left exception), return ())--{-|-Read from a file by path.--* Exception-free-* Automatic resource management--}-{-# INLINABLE fileBytesAtOffset #-}-fileBytesAtOffset :: FilePath -> Int -> Produce (Either IOException ByteString)-fileBytesAtOffset path offset =- Produce (catchIOError success failure)- where- success =- do- handle <- openBinaryFile path ReadMode- hSeek handle AbsoluteSeek (fromIntegral offset)- return (A.handleBytes handle ioChunkSize, catchIOError (hClose handle) (const (return ())))- failure exception =- return (pure (Left exception), return ())--{-|-Sorted subpaths of the directory.--}-{-# INLINABLE directoryContents #-}-directoryContents :: FilePath -> Produce (Either IOException FilePath)-directoryContents path =- Produce (catchIOError success failure)- where- success =- do- subPaths <- G.listDirectory path- ref <- newIORef (map (Right . mappend path . (:) '/') (sort subPaths))- return (A.list ref, return ())- failure exception =- return (pure (Left exception), return ())--{-|-Read from a file by path.--* Exception-free-* Automatic resource management--}-{-# INLINABLE fileText #-}-fileText :: FilePath -> Produce (Either IOException Text)-fileText path =- Produce (catchIOError success failure)- where- success =- do- handle <- openFile path ReadMode- return (A.handleText handle, catchIOError (hClose handle) (const (return ())))- failure exception =- return (pure (Left exception), return ())--{-|-Read from MVar.-Nothing gets interpreted as the end of input.--}-{-# INLINE finiteMVar #-}-finiteMVar :: MVar (Maybe element) -> Produce element-finiteMVar var =- Produce (return (A.finiteMVar var, return ()))--{-|-Read from MVar.-Never stops.--}-{-# INLINE infiniteMVar #-}-infiniteMVar :: MVar element -> Produce element-infiniteMVar var =- Produce (return (A.infiniteMVar var, return ()))
library/Potoki/Transform.hs view
@@ -8,245 +8,55 @@ ioTransform, take, takeWhile,+ drop, mapFilter, filter, just,+ list,+ vector,+ batch,+ distinctBy, distinct,- builderChunks, executeIO, mapInIO,+ reportProgress,+ handleProgressAndCountOnInterval,+ -- * ByteString+ builderChunks,+ extractLines,+ extractLinesWithoutTrail,+ extractLinesConcurrently,+ -- * State+ runState,+ execState,+ evalState, -- * Parsing+ scan, parseBytes, parseText,+ parseLineBytesConcurrently,+ parseNonEmptyLineBytesConcurrently, -- * Concurrency bufferize,+ bufferizeFlushing, concurrently,+ concurrentlyInOrder,+ unsafeConcurrently,+ async,+ concurrentlyWithBatching,+ concurrentlyInOrderWithBatching, -- * File IO deleteFile, appendBytesToFile,+ writeTextToFile,+ -- * Debugging+ count,+ mapInIOWithCounter,+ handleCount,+ handleCountOnInterval,+ traceWithCounter, ) where -import Potoki.Prelude hiding (take, takeWhile, filter) 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 System.Directory as I-import qualified Control.Concurrent.Chan.Unagi.Bounded as B --{-# 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 bufferize #-}-bufferize :: Int -> Transform element element-bufferize size =- Transform $ \ (A.Fetch fetch) -> do- (inChan, outChan) <- B.newChan size- forkIO $ fix $ \ loop ->- join $ fetch- (B.writeChan inChan Nothing)- (\ !element -> B.writeChan inChan (Just element) >> loop)- return $ A.Fetch $ \ nil just -> fmap (maybe nil just) (B.readChan outChan)--{-|-Identity Transform, which ensures that the inputs are fetched synchronously.--Useful for concurrent transforms.--}-{-# INLINABLE sync #-}-sync :: Transform a a-sync =- Transform $ \ (A.Fetch fetch) -> do- activeVar <- newMVar True- return $ A.Fetch $ \ nil just -> do- active <- takeMVar activeVar- if active- then join $ fetch- (do- putMVar activeVar False- return nil)- (\ !element -> do- putMVar activeVar True- return (just element))- else do- putMVar activeVar False- return nil--{-|-Execute the transform on the specified amount of threads.-The order of the outputs produced is indiscriminate.--}-{-# INLINABLE concurrently #-}-concurrently :: Int -> Transform input output -> Transform input output-concurrently workersAmount transform =- sync >>>- concurrentlyUnsafe workersAmount transform--{-# INLINE concurrentlyUnsafe #-}-concurrentlyUnsafe :: Int -> Transform input output -> Transform input output-concurrentlyUnsafe workersAmount (Transform syncTransformIO) =- Transform $ \ fetch -> do- outChan <- newEmptyMVar- replicateM_ workersAmount $ forkIO $ do- A.Fetch fetchIO <- syncTransformIO fetch- fix $ \ loop -> join $ fetchIO- (putMVar outChan Nothing)- (\ !result -> putMVar outChan (Just result) >> loop)- activeWorkersAmountVar <- newMVar workersAmount- return $ A.Fetch $ \ nil just -> fix $ \ loop -> do- activeWorkersAmount <- takeMVar activeWorkersAmountVar- if activeWorkersAmount <= 0- then return nil- else do- fetchResult <- takeMVar outChan- case fetchResult of- Just result -> do- putMVar activeWorkersAmountVar activeWorkersAmount- return (just result)- Nothing -> do- putMVar activeWorkersAmountVar (pred activeWorkersAmount)- loop--{-# 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--{-# INLINE distinct #-}-distinct :: (Eq element, Hashable element) => Transform element element-distinct =- Transform $ \ (A.Fetch fetch) -> do- stateRef <- newIORef mempty- return $ A.Fetch $ \ nil just -> fix $ \ loop -> join $ fetch (return nil) $ \ !input -> do- !set <- readIORef stateRef- if C.member input set- then loop- else do- writeIORef stateRef $! C.insert input set- return (just input)--{-# 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
potoki.cabal view
@@ -1,7 +1,7 @@ name: potoki version:- 0.6.5+ 2.1.4.1 synopsis: Simple streaming in IO description:@@ -30,18 +30,21 @@ Also, in difference to \"io-streams\", \"potoki\" doesn't use exceptions for control-flow. In fact, \"potoki\" doesn't use exceptions whatsoever, instead it makes failures explicit, using the standard @Either@ type.+ .+ \"potoki\" comes with automated resource-management (acquisition and clean-up),+ concurrency and buffering features. category: Streaming homepage:- https://github.com/nikita-volkov/potoki + https://github.com/metrix-ai/potoki bug-reports:- https://github.com/nikita-volkov/potoki/issues + https://github.com/metrix-ai/potoki/issues author: Nikita Volkov <nikita.y.volkov@mail.ru> maintainer:- Nikita Volkov <nikita.y.volkov@mail.ru>+ Metrix.AI Tech Team <tech@metrix.ai> copyright:- (c) 2017, Nikita Volkov+ (c) 2017, Metrix.AI license: MIT license-file:@@ -55,7 +58,7 @@ type: git location:- git://github.com/nikita-volkov/potoki.git+ git://github.com/metrix-ai/potoki.git library hs-source-dirs:@@ -69,42 +72,6 @@ Potoki.IO Potoki.Produce Potoki.Transform- other-modules:- Potoki.Fetch- Potoki.Prelude build-depends:- attoparsec >=0.13 && <0.15,- base >=4.7 && <5,- base-prelude <2,- bytestring ==0.10.*,- directory >=1.3 && <2,- foldl >=1.3 && <2,- hashable >=1 && <2,- potoki-core >=1.2 && <1.3,- profunctors >=5.2 && <6,- text >=1 && <2,- unagi-chan >=0.4 && <0.5,- unordered-containers >=0.2 && <0.3,- vector >=0.12 && <0.13+ potoki-core >=2.3.4.1 && <2.4 -test-suite tests- type:- exitcode-stdio-1.0- hs-source-dirs:- tests- main-is:- Main.hs- default-extensions:- Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, 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:- attoparsec,- potoki,- QuickCheck >=2.8.1 && <3,- quickcheck-instances >=0.3.11 && <0.4,- random >=1.1 && <2,- rerebase >=1.1 && <2,- tasty >=0.12 && <0.13,- tasty-hunit >=0.9 && <0.11,- tasty-quickcheck >=0.9 && <0.10
− tests/Main.hs
@@ -1,118 +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 "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- ]