packages feed

potoki (empty) → 0.6.1

raw patch · 10 files changed

+969/−0 lines, 10 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed

Dependencies added: QuickCheck, attoparsec, base, base-prelude, bug, bytestring, directory, foldl, hashable, potoki, potoki-core, profunctors, quickcheck-instances, random, rerebase, tasty, tasty-hunit, tasty-quickcheck, text, unagi-chan, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2017, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ library/Potoki/Consume.hs view
@@ -0,0 +1,177 @@+module Potoki.Consume+(+  Consume,+  transform,+  count,+  sum,+  head,+  list,+  reverseList,+  concat,+  fold,+  foldInIO,+  writeBytesToFile,+  appendBytesToFile,+  deleteFiles,+  printBytes,+  printText,+  printString,+  parseBytes,+  parseText,+)+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 ->+  L.fetchAndHandleAll fetch (return ()) $ \ bytes -> +  C.hPut handle bytes++{-|+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 ->+  L.fetchAndHandleAll fetch (return ()) $ \ bytes -> +  C.hPut handle bytes++{-# 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 view
@@ -0,0 +1,72 @@+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 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/IO.hs view
@@ -0,0 +1,10 @@+module Potoki.IO+(+  produceAndConsume,+  produce,+  consume,+)+where++import Potoki.Core.IO+
+ library/Potoki/Prelude.hs view
@@ -0,0 +1,60 @@+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)++-- bug+-------------------------+import Bug as Exports++--------------------------------------------------------------------------------++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
@@ -0,0 +1,143 @@+module Potoki.Produce+(+  Produce,+  transform,+  list,+  vector,+  hashMapRows,+  fileBytes,+  fileBytesAtOffset,+  fileText,+  directoryContents,+  finiteMVar,+  infiniteMVar,+)+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 ())++{-# 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 . (:) '/') 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
@@ -0,0 +1,246 @@+module Potoki.Transform+(+  Transform,+  -- * Potoki integration+  consume,+  produce,+  -- * Basics+  ioTransform,+  take,+  takeWhile,+  mapFilter,+  just,+  distinct,+  builderChunks,+  executeIO,+  mapInIO,+  -- * Parsing+  parseBytes,+  parseText,+  -- * Concurrency+  bufferize,+  concurrently,+  -- * File IO+  deleteFile,+  appendBytesToFile,+)+where++import Potoki.Prelude hiding (take, takeWhile)+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 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
@@ -0,0 +1,119 @@+name:+  potoki+version:+  0.6.1+synopsis:+  Simple streaming in IO+description:+  This library provides a new simpler approach to the IO-streaming problem.+  .+  In difference to libraries like \"pipes\", \"conduit\", \"streaming\",+  this library is specialised to streaming in the IO monad,+  which greatly simplifies the abstractions that it provides.+  This simplification is motivated by the fact that the majority of streaming+  tasks are performed in IO anyway.+  .+  Also, unlike the mentioned libraries,+  \"potoki\" API doesn't treat streaming as a side operation in its abstractions,+  which allows it to express the composition of streams using the standard+  typeclass instances, thus simplifying the API even further.+  .+  Naturally, being simpler limits the application area of this library.+  Thus it is not capable of transforming custom context monads and etc.+  It is a tradeoff, but, as we expect, the user will rarely be affected by it.+  .+  Another benefit of being specialized to IO is the ability to optimize for performance better.+  It must however be mentioned that this is only theoretical and no benchmarks have yet been performed.+  .+  In some of the mentioned regards \"potoki\" is similar to the \"io-streams\" library.+  However, unlike that library it approaches composition with the standard typeclass instances.+  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.+category:+  Streaming+homepage:+  https://github.com/nikita-volkov/potoki +bug-reports:+  https://github.com/nikita-volkov/potoki/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2017, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10++source-repository head+  type:+    git+  location:+    git://github.com/nikita-volkov/potoki.git++library+  hs-source-dirs:+    library+  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+  exposed-modules:+    Potoki.IO+    Potoki.Produce+    Potoki.Consume+    Potoki.Transform+  other-modules:+    Potoki.Fetch+    Potoki.Prelude+  build-depends:+    -- +    potoki-core >=1.2 && <1.3,+    -- +    attoparsec >=0.13 && <0.15,+    -- +    text >=1 && <2,+    bytestring ==0.10.*,+    vector >=0.12 && <0.13,+    hashable >=1 && <2,+    -- +    unagi-chan >=0.4 && <0.5,+    -- +    directory >=1.3 && <2,+    unordered-containers >=0.2 && <0.3,+    foldl >=1.3 && <2,+    profunctors >=5.2 && <6,+    base-prelude <2,+    bug >=1 && <2,+    base >=4.7 && <5++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:+    -- +    potoki,+    attoparsec,+    random >=1.1 && <2,+    -- testing:+    tasty >=0.12 && <0.13,+    tasty-quickcheck >=0.9 && <0.10,+    tasty-hunit >=0.9 && <0.11,+    quickcheck-instances >=0.3.11 && <0.4,+    QuickCheck >=2.8.1 && <3,+    --+    rerebase >=1.1 && <2
+ tests/Main.hs view
@@ -0,0 +1,118 @@+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+  ]