pipes-misc 0.3.0.0 → 0.4.0.0
raw patch · 6 files changed
+7/−35 lines, 6 files
Files
- pipes-misc.cabal +1/−1
- src/Pipes/Misc/Concurrent.hs +4/−12
- src/Pipes/Misc/State/Lazy.hs +0/−4
- src/Pipes/Misc/State/Strict.hs +0/−4
- src/Pipes/Misc/Time.hs +1/−7
- src/Pipes/Misc/Util.hs +1/−7
pipes-misc.cabal view
@@ -1,5 +1,5 @@ name: pipes-misc-version: 0.3.0.0+version: 0.4.0.0 synopsis: Miscellaneous utilities for pipes, required by glazier-tutorial description: Please see README.md homepage: https://github.com/louispan/pipes-misc#readme
src/Pipes/Misc/Concurrent.hs view
@@ -9,7 +9,6 @@ import Control.Monad.Morph import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe-import Control.Monad.Trans.Reader import qualified Data.List.NonEmpty as NE import qualified Pipes as P import qualified Pipes.Concurrent as PC@@ -26,7 +25,6 @@ fromInputSTM as = void $ runMaybeT $ forever $ do a <- MaybeT $ lift $ PC.recv as lift $ P.yield a-{-# INLINABLE fromInputSTM #-} -- | Like Pipes.Concurrent.toOutput, but stays in STM. -- Using @hoist atomically@ to convert to IO monad seems to work.@@ -36,12 +34,10 @@ a <- lift P.await p <- lift $ lift $ PC.send output a guard p-{-# INLINABLE toOutputSTM #-} -- | Convert PC.Output @a -> STM Bool@ to @a -> MaybeT STM ()@ toOutputMaybeT :: PC.Output a -> a -> MaybeT STM () toOutputMaybeT output = (MaybeT . fmap guard) <$> PC.send output-{-# INLINABLE toOutputMaybeT #-} -- | Converts a Producer in IO monad to a producer in STM monad. mkProducerSTM :: PC.Buffer a -> P.Producer a IO () -> IO (P.Producer a STM ())@@ -49,7 +45,6 @@ (output, input) <- PC.spawn b void . forkIO . void . forever . P.runEffect $ xs P.>-> PC.toOutput output pure (fromInputSTM input)-{-# INLINABLE mkProducerSTM #-} -- | Converts a Producer in IO monad to a producer in STM monad. Also returns the seal. mkProducerSTM' :: PC.Buffer a -> P.Producer a IO () -> IO (STM (), P.Producer a STM ())@@ -57,7 +52,6 @@ (output, input, seal) <- PC.spawn' b void . forkIO . void . forever . P.runEffect $ xs P.>-> PC.toOutput output pure (seal, fromInputSTM input)-{-# INLINABLE mkProducerSTM' #-} -- | Reads as much as possible from an input and return a list of all unblocked values read. -- Blocks if the first value read is blocked.@@ -78,13 +72,11 @@ tryCons ys x = case x of Nothing -> Left ys -- return successful reads so far Just x' -> Right $ x' NE.<| ys-{-# INLINABLE batch #-} --- | Combine a 'Pipes.Concurrent.Input' and a 'ReaderT a STM r' into a 'Pipes.Producer' of the result r.--- That is, given a input of messages, and something that executes the messages to produce a result r,+-- | Combine a 'Pipes.Concurrent.Input' and a 'a -> t STM b' into a 'Pipes.Producer' of the result b.+-- That is, given a input of messages, and something that executes the messages to produce a result b, -- combine them to get a Producer of the executed results. execInput :: (MonadTrans t, Monad (t STM))- => PC.Input a -> ReaderT a (t STM) b -> P.Producer' b (t STM) ()-execInput input m = hoist lift (fromInputSTM input) P.>-> PP.mapM (runReaderT m)-{-# INLINABLE execInput #-}+ => PC.Input a -> (a -> (t STM) b) -> P.Producer' b (t STM) ()+execInput input f = hoist lift (fromInputSTM input) P.>-> PP.mapM f
src/Pipes/Misc/State/Lazy.hs view
@@ -14,7 +14,6 @@ a <- P.await s .= view v a P.yield a-{-# INLINABLE store #-} -- | Yields a view into the stored value. retrieve :: MonadState s m => Getter s b -> P.Pipe a (b, a) m r@@ -22,7 +21,6 @@ a <- P.await s <- get P.yield (view v s, a)-{-# INLINABLE retrieve #-} -- | Yields a view into the stored value retrieve' :: MonadState s m => Getter s b -> P.Pipe () b m r@@ -30,7 +28,6 @@ P.await s <- get P.yield (view v s)-{-# INLINABLE retrieve' #-} -- | Do something with the state everytime there is a yield. onState :: (MonadState s m) => (s -> m ()) -> P.Pipe a a m r@@ -38,4 +35,3 @@ s <- get f s pure a-{-# INLINABLE onState #-}
src/Pipes/Misc/State/Strict.hs view
@@ -13,7 +13,6 @@ a <- P.await s .= view v a P.yield a-{-# INLINABLE store #-} -- | Yields a view into the stored value. retrieve :: MonadState s m => Getter s b -> P.Pipe a (b, a) m r@@ -21,7 +20,6 @@ a <- P.await s <- get P.yield (view v s, a)-{-# INLINABLE retrieve #-} -- | Yields a view into the stored value retrieve' :: MonadState s m => Getter s b -> P.Pipe () b m r@@ -29,7 +27,6 @@ P.await s <- get P.yield (view v s)-{-# INLINABLE retrieve' #-} -- | Do something with the state everytime there is a yield. onState :: (MonadState s m) => (s -> m ()) -> P.Pipe a a m r@@ -37,4 +34,3 @@ s <- get f s pure a-{-# INLINABLE onState #-}
src/Pipes/Misc/Time.hs view
@@ -12,7 +12,7 @@ -- -- diffAndTickEvery :: MonadIO io => C.Clock -> Int -> P.Producer' (C.TimeSpec, C.TimeSpec) io r -- diffAndTickEvery clock micros = always () P.>-> delay micros P.>-> ticker clock P.>->--- PS.runShaft (PS.Shaft diffTime &&& Cat.id)+-- PS.fromShaft (PS.Shaft diffTime &&& Cat.id) -- -- @ --@@ -31,7 +31,6 @@ delay i = PP.mapM $ \a -> do liftIO $ threadDelay i pure a-{-# INLINABLE delay #-} -- | After the first await, add a delay after every subsequent await. delay' :: MonadIO io => Int -> P.Pipe a a io r@@ -39,12 +38,10 @@ a <- P.await P.yield a delay i-{-# INLINABLE delay' #-} -- | obtain the threadDelay given a fps fps :: D.Decimal -> Int fps x = truncate (D.roundTo 0 (D.Decimal 0 1000000 / x))-{-# INLINABLE fps #-} -- | Continuously yield the clock time -- Use with delay to reduce the yield rate. Eg:@@ -58,14 +55,11 @@ ticker clock = P.for P.cat $ \() -> do t <- liftIO $ C.getTime clock P.yield t-{-# INLINABLE ticker #-} -- | Converts a stream of times, into a stream of delta time. The first yield is zero. diffTime :: Monad m => P.Pipe C.TimeSpec C.TimeSpec m r diffTime = PM.compare C.diffTimeSpec (C.TimeSpec 0 0)-{-# INLINABLE diffTime #-} -- | Converts a stream of epoch times into a stream of epoch time, where zero is the first yielded time. resetEpoch :: Monad m => P.Pipe C.TimeSpec C.TimeSpec m r resetEpoch = PM.compare' C.diffTimeSpec-{-# INLINABLE resetEpoch #-}
src/Pipes/Misc/Util.hs view
@@ -36,7 +36,6 @@ where -- from https://ro-che.info/articles/2015-05-28-force-list forceSpine = foldr (const id) ()-{-# INLINABLE buffer #-} -- | Run a pipe in a larger stream, using view function and modify function -- of the larger stream.@@ -48,9 +47,8 @@ -> P.Pipe s t m r locally viewf modifyf p = PP.map (\s -> (s, s))- P.>-> PS.runShaft (first $ PS.Shaft $ PP.map viewf P.>-> p)+ P.>-> PS.fromShaft (first $ PS.Shaft $ PP.map viewf P.>-> p) P.>-> PP.map (uncurry modifyf)-{-# INLINABLE locally #-} -- | Given comparison function and an initial value. -- yield the result of comparing the value await with the previously awaited value.@@ -64,7 +62,6 @@ b <- P.await P.yield (f b a) go b-{-# INLINABLE compare #-} -- | Given comparison function -- yield the result of comparing the value await with the first awaited value.@@ -77,12 +74,10 @@ go i = forever $ do a <- P.await P.yield (f a i)-{-# INLINABLE compare' #-} -- | constantly yields the given value always :: Monad m => a -> P.Producer a m r always = forever . P.yield-{-# INLINABLE always #-} -- | Makes the Producer return/pure the last value yielded, or the input value if nothing -- was yielded@@ -95,4 +90,3 @@ Respond b fb' -> Respond b (go b . fb') M m -> M (m >>= pure . go i) Pure () -> Pure i-{-# INLINABLE lastOr #-}