potoki-core 2.2.5.4 → 2.2.6
raw patch · 7 files changed
+127/−84 lines, 7 filesdep +primitivedep +scannerPVP ok
version bump matches the API change (PVP)
Dependencies added: primitive, scanner
API changes (from Hackage documentation)
+ Potoki.Core.Transform: scan :: Scanner a -> Transform ByteString (Either Text a)
Files
- library/Potoki/Core/Prelude.hs +5/−1
- library/Potoki/Core/Transform.hs +2/−0
- library/Potoki/Core/Transform/Attoparsec.hs +12/−12
- library/Potoki/Core/Transform/ByteString.hs +11/−6
- library/Potoki/Core/Transform/Concurrency.hs +6/−7
- library/Potoki/Core/Transform/Scanner.hs +54/−0
- potoki-core.cabal +37/−58
library/Potoki/Core/Prelude.hs view
@@ -52,7 +52,7 @@ import Foreign.ForeignPtr as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports-import Foreign.Storable as Exports+import Foreign.Storable as Exports hiding (sizeOf, alignment) import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead) import GHC.Exts as Exports (lazy, inline, sortWith, groupWith) import GHC.Generics as Exports (Generic)@@ -106,6 +106,10 @@ -- hashable ------------------------- import Data.Hashable as Exports (Hashable)++-- primitive+-------------------------+import Data.Primitive as Exports --------------------------------------------------------------------------------
library/Potoki/Core/Transform.hs view
@@ -25,6 +25,7 @@ R.execState, R.evalState, -- * Parsing+ B.scan, A.parseBytes, A.parseText, A.parseLineBytesConcurrently,@@ -47,6 +48,7 @@ import Potoki.Core.Transform.FileIO import Potoki.Core.Transform.ByteString import qualified Potoki.Core.Transform.Attoparsec as A+import qualified Potoki.Core.Transform.Scanner as B import qualified Potoki.Core.Transform.Concurrency as N import qualified Potoki.Core.Transform.State as R
library/Potoki/Core/Transform/Attoparsec.hs view
@@ -18,18 +18,18 @@ mapWithParseResult :: forall input parsed. (Monoid input, Eq input) => (input -> M.IResult input parsed) -> Transform input (Either Text parsed) mapWithParseResult inputToResult = Transform $ \inputFetch -> N.Acquire $ do- unconsumedRef <- newIORef mempty- finishedRef <- newIORef False+ unconsumedRef <- newMutVar mempty+ finishedRef <- newMutVar False return (A.Fetch (fetchParsed inputFetch finishedRef unconsumedRef), return ()) where- fetchParsed :: A.Fetch input -> IORef Bool -> IORef input -> IO (Maybe (Either Text parsed))+ fetchParsed :: A.Fetch input -> MutVar RealWorld Bool -> MutVar RealWorld input -> IO (Maybe (Either Text parsed)) fetchParsed (A.Fetch inputFetchIO) finishedRef unconsumedRef = do- finished <- readIORef finishedRef+ finished <- readMutVar finishedRef if finished then return Nothing else do- unconsumed <- readIORef unconsumedRef+ unconsumed <- readMutVar unconsumedRef if unconsumed == mempty then inputFetchIO >>= \case@@ -39,7 +39,7 @@ then return Nothing else matchResult (inputToResult input) else do- writeIORef unconsumedRef mempty+ writeMutVar unconsumedRef mempty matchResult (inputToResult unconsumed) where matchResult :: M.IResult input parsed -> IO (Maybe (Either Text parsed))@@ -49,12 +49,12 @@ consumeVal inputToResultVal M.Done unconsumed parsed -> do- writeIORef unconsumedRef unconsumed+ writeMutVar unconsumedRef unconsumed return (Just (Right parsed)) M.Fail unconsumed contexts message -> do- writeIORef unconsumedRef unconsumed- writeIORef finishedRef True+ writeMutVar unconsumedRef unconsumed+ writeMutVar finishedRef True return (Just (Left resultMessage)) where resultMessage =@@ -64,10 +64,10 @@ consumeVal inputToResultVal' = inputFetchIO >>= \case Nothing -> do- writeIORef finishedRef True+ writeMutVar finishedRef True matchResult (inputToResultVal' mempty) Just input -> do- when (input == mempty) (writeIORef finishedRef True)+ when (input == mempty) (writeMutVar finishedRef True) matchResult (inputToResultVal' input) {-|@@ -103,5 +103,5 @@ {-# INLINE parseNonEmptyLineBytesConcurrently #-} parseNonEmptyLineBytesConcurrently :: Int -> K.Parser a -> Transform ByteString (Either Text a) parseNonEmptyLineBytesConcurrently concurrency parser =- extractLinesWithoutTrail >>> filter (not . ByteString.null) >>> bufferize concurrency >>>+ extractLinesWithoutTrail >>> filter (not . ByteString.null) >>> bufferize (concurrency * 2) >>> concurrentlyUnsafe concurrency (arr (mapLeft fromString . K.parseOnly parser))
library/Potoki/Core/Transform/ByteString.hs view
@@ -47,10 +47,11 @@ newPoking = fold state <> C.bytes firstInput in case unsnoc tailVal of- Just (initVal, lastVal) ->+ Just (!initVal, !lastVal) -> do- writeIORef stateRef (Just (C.bytes lastVal))- return (Just (D.poking newPoking : initVal))+ writeIORef stateRef $! Just $! C.bytes lastVal+ let !bytes = D.poking newPoking+ return (Just (bytes : initVal)) Nothing -> do writeIORef stateRef (Just newPoking)@@ -70,9 +71,11 @@ poking <- readIORef pokingRef let newPoking = poking <> C.bytes head case unsnoc tail of- Just (init, last) -> do+ Just (!init, last) -> do writeIORef pokingRef (C.bytes last)- return (Just (D.poking newPoking : init))+ let+ !bytes = D.poking newPoking+ in return (Just (bytes : init)) Nothing -> do writeIORef pokingRef newPoking return (Just [])@@ -81,4 +84,6 @@ poking <- readIORef pokingRef if C.null poking then return Nothing- else return (Just (D.poking poking : []))+ else let+ !bytes = D.poking poking+ in return (Just (bytes : []))
library/Potoki/Core/Transform/Concurrency.hs view
@@ -73,9 +73,9 @@ concurrentlyUnsafe :: Int -> Transform input output -> Transform input output concurrentlyUnsafe workersAmount (Transform syncTransformIO) = Transform $ \ fetchIO -> liftIO $ do- chan <- atomically newEmptyTMVar- workersCounter <- atomically (newTVar workersAmount)- fetchingAvailableVar <- atomically (newTVar True)+ chan <- newTBQueueIO (workersAmount * 2)+ workersCounter <- newTVarIO workersAmount+ fetchingAvailableVar <- newTVarIO True replicateM_ workersAmount $ forkIO $ do (A.Fetch fetchIO, finalize) <- case syncTransformIO fetchIO of M.Acquire io -> io@@ -83,14 +83,13 @@ fetchResult <- fetchIO case fetchResult of Just !result -> do- atomically (putTMVar chan result)+ atomically (writeTBQueue chan result) loop- Nothing -> do- atomically $ modifyTVar' workersCounter pred+ Nothing -> atomically (modifyTVar' workersCounter pred) finalize return $ A.Fetch $ let- readChan = Just <$> takeTMVar chan+ readChan = Just <$> readTBQueue chan terminate = do workersActive <- readTVar workersCounter if workersActive > 0
+ library/Potoki/Core/Transform/Scanner.hs view
@@ -0,0 +1,54 @@+module Potoki.Core.Transform.Scanner+where++import Potoki.Core.Prelude hiding (take, takeWhile, filter, drop)+import Potoki.Core.Types+import Potoki.Core.Transform.Basic+import Scanner+++{-# INLINE scan #-}+scan :: Scanner a -> Transform ByteString (Either Text a)+scan scanner =+ Transform $ \ (Fetch fetchIo) -> liftIO $ do+ unconsumedRef <- newMutVar mempty+ finishedRef <- newMutVar False+ return $ Fetch $ let+ matchResult =+ \ case+ More inputToResultVal ->+ consumeVal inputToResultVal+ Done unconsumed parsed ->+ do+ writeMutVar unconsumedRef unconsumed+ return (Just (Right parsed))+ Fail unconsumed message ->+ do+ writeMutVar unconsumedRef unconsumed+ writeMutVar finishedRef True+ return (Just (Left (fromString message)))+ consumeVal inputToResultVal' =+ fetchIo >>= \ case+ Nothing -> do+ writeMutVar finishedRef True+ matchResult (inputToResultVal' mempty)+ Just input -> do+ when (input == mempty) (writeMutVar finishedRef True)+ matchResult (inputToResultVal' input)+ in do+ finished <- readMutVar finishedRef+ if finished+ then return Nothing+ else do+ unconsumed <- readMutVar unconsumedRef+ if unconsumed == mempty+ then+ fetchIo >>= \ case+ Nothing -> return Nothing+ Just input -> do+ if input == mempty+ then return Nothing+ else matchResult (Scanner.scan scanner input)+ else do+ writeMutVar unconsumedRef mempty+ matchResult (Scanner.scan scanner unconsumed)
potoki-core.cabal view
@@ -1,47 +1,31 @@-name:- potoki-core-version:- 2.2.5.4-synopsis:- Low-level components of "potoki"+name: potoki-core+version: 2.2.6+synopsis: Low-level components of "potoki" description: Provides everything required for building custom instances of the \"potoki\" abstractions. Consider this library to be the Internals modules of \"potoki\".-category:- Streaming-homepage:- https://github.com/metrix-ai/potoki-core-bug-reports:- https://github.com/metrix-ai/potoki-core/issues-author:- Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer:- Metrix.AI Tech Team <tech@metrix.ai>-copyright:- (c) 2017, Metrix.AI-license:- MIT-license-file:- LICENSE-build-type:- Simple-cabal-version:- >=1.10+category: Streaming+homepage: https://github.com/metrix-ai/potoki-core+bug-reports: https://github.com/metrix-ai/potoki-core/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Metrix.AI Tech Team <tech@metrix.ai>+copyright: (c) 2017, Metrix.AI+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >=1.10+tested-with: GHC ==8.4.2, GHC ==8.6.* + source-repository head- type:- git- location:- git://github.com/metrix-ai/potoki-core.git+ type: git+ location: git://github.com/metrix-ai/potoki-core.git library- hs-source-dirs:- library- 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+ hs-source-dirs: library+ 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 exposed-modules: Potoki.Core.Produce Potoki.Core.Fetch@@ -57,6 +41,7 @@ Potoki.Core.Transform.Concurrency Potoki.Core.Transform.FileIO Potoki.Core.Transform.State+ Potoki.Core.Transform.Scanner Potoki.Core.Transform.Instances Potoki.Core.IO.Fetch build-depends:@@ -67,8 +52,10 @@ directory >=1.3 && <2, foldl >=1.3 && <2, hashable >=1 && <2,+ primitive >=0.6.4 && <0.7, profunctors >=5.2 && <6, ptr >=0.16.2 && <0.17,+ scanner >=0.2 && <0.3, stm >=2.4 && <3, text >=1 && <2, transformers >=0.5 && <0.6,@@ -76,32 +63,24 @@ vector >=0.12 && <0.13 test-suite tests- type:- exitcode-stdio-1.0- hs-source-dirs:- tests- main-is:- Main.hs+ 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, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language: Haskell2010 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, 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,+ attoparsec, foldl >=1.3.7 && <1.4, ilist >=0.3.1.0 && <0.4,- --- rerebase >=1.1 && <2+ potoki-core,+ QuickCheck >=2.8.1 && <3,+ quickcheck-instances >=0.3.11 && <0.4,+ random >=1.1 && <2,+ rerebase >=1.1 && <2,+ tasty >=1.0.1 && <1.2,+ tasty-hunit >=0.10 && <0.11,+ tasty-quickcheck >=0.10 && <0.11