pipes-vector 0.5.1 → 0.5.2
raw patch · 3 files changed
+110/−86 lines, 3 filesdep +monad-primitive
Dependencies added: monad-primitive
Files
- Pipes/Vector.hs +0/−84
- pipes-vector.cabal +9/−2
- src/Pipes/Vector.hs +101/−0
− Pipes/Vector.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE RankNTypes, FlexibleContexts, GeneralizedNewtypeDeriving #-}--{-| Pipes for interfacing with "Data.Vector".-- Note that this only provides functionality for building @Vectors@- from Pipes; as @Vectors@ are @Foldable@ the inverse can be- accomplished with "Pipes.each".--}--module Pipes.Vector (- -- * Usage- -- $usage- -- * Building Vectors from Pipes- toVector,- runToVectorP,- runToVector,- ToVector- ) where--import Control.Applicative-import Control.Monad-import Control.Monad.Trans.State.Strict as S-import Control.Monad.Primitive-import Pipes-import Pipes.Internal (unsafeHoist)-import Pipes.Lift-import qualified Data.Vector.Generic as V-import qualified Data.Vector.Generic.Mutable as M--data ToVectorState v e m = ToVecS { result :: V.Mutable v (PrimState m) e- , idx :: Int- }--newtype ToVector v e m r = TV {unTV :: S.StateT (ToVectorState v e m) m r}- deriving (Functor, Applicative, Monad)--maxChunkSize :: Int-maxChunkSize = 8*1024*1024---- | Consume items from a Pipe and place them into a vector------ For efficient filling, the vector is grown geometrically up to a--- maximum chunk size.-toVector- :: (PrimMonad m, M.MVector (V.Mutable v) e)- => Consumer e (ToVector v e m) r-toVector = forever $ do- length <- M.length . result <$> lift (TV get)- pos <- idx `liftM` lift (TV get)- lift $ TV $ when (pos >= length) $ do- v <- result `liftM` get- v' <- lift $ M.unsafeGrow v (min length maxChunkSize)- modify $ \(ToVecS r i) -> ToVecS v' i- r <- await- lift $ TV $ do- v <- result `liftM` get- lift $ M.unsafeWrite v pos r- modify $ \(ToVecS r i) -> ToVecS r (pos+1)---- | Extract and freeze the constructed vector-runToVectorP- :: (PrimMonad m, V.Vector v e)- => Proxy a' a b' b (ToVector v e m) r- -> Proxy a' a b' b m (v e)-runToVectorP x = do- v <- lift $ M.new 10- s <- execStateP (ToVecS v 0) (hoist unTV x)- frozen <- lift $ V.freeze (result s)- return $ V.take (idx s) frozen--runToVector :: (PrimMonad m, V.Vector v e)- => ToVector v e m r -> m (v e)-runToVector (TV a) = do- v <- M.new 10- s <- execStateT a (ToVecS v 0)- frozen <- V.freeze (result s)- return $ V.take (idx s) frozen--{- $usage-- >>> run $ runToVectorP $ each [1..5::Int] >-> toVector- fromList [1,2,3,4,5]---}
pipes-vector.cabal view
@@ -1,5 +1,5 @@ name: pipes-vector-version: 0.5.1+version: 0.5.2 synopsis: Various proxies for streaming data into vectors description: Proxies for streaming data into vectors. license: BSD3@@ -12,10 +12,17 @@ cabal-version: >=1.10 library+ hs-source-dirs: src exposed-modules: Pipes.Vector build-depends: base >=3.0 && <5, transformers >= 0.2 && < 1.0, primitive >=0.4 && <1.0, pipes >=4.0 && <5.0,- vector >=0.9 && <1.0+ vector >=0.9 && <1.0,+ monad-primitive >= 0.1 && < 1.0 default-language: Haskell2010+ other-extensions: RankNTypes, FlexibleContexts, GeneralizedNewtypeDeriving, TypeFamilies++source-repository head+ type: git+ location: https://github.com/bgamari/pipes-vector
+ src/Pipes/Vector.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE RankNTypes, FlexibleContexts, GeneralizedNewtypeDeriving, TypeFamilies #-}++{-| Pipes for interfacing with "Data.Vector".++ Note that this only provides functionality for building @Vectors@+ from Pipes; as @Vectors@ are @Foldable@ the inverse can be+ accomplished with "Pipes.each".+-}++module Pipes.Vector (+ -- * Usage+ -- $usage+ -- * Building Vectors from Pipes+ toVector,+ runToVectorP,+ runToVector,+ fromProducer,+ ToVector+ ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans.State.Strict as S+import Control.Monad.Primitive+import Control.Monad.Primitive.Class+import Pipes+import Pipes.Internal (unsafeHoist)+import Pipes.Lift+import qualified Data.Vector.Generic as V+import qualified Data.Vector.Generic.Mutable as M++data ToVectorState v e m = ToVecS { result :: V.Mutable v (PrimState (BasePrimMonad m)) e+ , idx :: Int+ }++newtype ToVector v e m r = TV {unTV :: S.StateT (ToVectorState v e m) m r}+ deriving (Functor, Applicative, Monad)++instance MonadTrans (ToVector v e) where+ lift = TV . lift++-- Nasty orphan instances+instance MonadPrim m => MonadPrim (Proxy a' a b' b m) where+ type BasePrimMonad (Proxy a' a b' b m) = BasePrimMonad m+ liftPrim = lift . liftPrim+ +instance MonadPrim m => MonadPrim (ToVector v e m) where+ type BasePrimMonad (ToVector v e m) = BasePrimMonad m+ liftPrim = TV . liftPrim+ +maxChunkSize :: Int+maxChunkSize = 8*1024*1024++-- | Consume items from a Pipe and place them into a vector+--+-- For efficient filling, the vector is grown geometrically up to a+-- maximum chunk size.+toVector+ :: (MonadPrim m, M.MVector (V.Mutable v) e)+ => Consumer e (ToVector v e m) r+toVector = forever $ do+ length <- M.length . result <$> lift (TV get)+ pos <- idx `liftM` lift (TV get)+ lift $ TV $ when (pos >= length) $ do+ v <- result `liftM` get+ v' <- liftPrim $ M.unsafeGrow v (min length maxChunkSize)+ modify $ \(ToVecS r i) -> ToVecS v' i+ r <- await+ lift $ TV $ do+ v <- result `liftM` get+ liftPrim $ M.unsafeWrite v pos r+ modify $ \(ToVecS r i) -> ToVecS r (pos+1)++-- | Extract and freeze the constructed vector+runToVectorP+ :: (MonadPrim m, V.Vector v e)+ => Proxy a' a b' b (ToVector v e m) r+ -> Proxy a' a b' b m (v e)+runToVectorP x = do+ v <- liftPrim $ M.new 10+ s <- execStateP (ToVecS v 0) (hoist unTV x)+ frozen <- liftPrim $ V.freeze (result s)+ return $ V.take (idx s) frozen++runToVector :: (MonadPrim m, V.Vector v e)+ => ToVector v e m r -> m (v e)+runToVector (TV a) = do+ v <- liftPrim $ M.new 10+ s <- execStateT a (ToVecS v 0)+ frozen <- liftPrim $ V.freeze (result s)+ return $ V.take (idx s) frozen++{- $usage++ >>> run $ runToVectorP $ each [1..5::Int] >-> toVector+ fromList [1,2,3,4,5]++-}++fromProducer :: (V.Vector v e, MonadPrim m) => Producer' e (ToVector v e m) r -> m (v e)+fromProducer p = runEffect $ runToVectorP (p >-> toVector)