packages feed

pipes-misc (empty) → 0.2.0.0

raw patch · 5 files changed

+213/−0 lines, 5 filesdep +basedep +hspecdep +lenssetup-changed

Dependencies added: base, hspec, lens, mtl, pipes, pipes-category, pipes-concurrency, pipes-misc, semigroups, stm, transformers

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2016, Louis Pan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pipes-misc.cabal view
@@ -0,0 +1,46 @@+name:                pipes-misc+version:             0.2.0.0+synopsis:            Miscellaneous utilities for pipes, required by glazier-tutorial+description:         Please see README.md+homepage:            https://github.com/louispan/pipes-misc#readme+license:             BSD3+license-file:        LICENSE+author:              Louis Pan+maintainer:          louis@pan.me+copyright:           2016 Louis Pan+category:            Control, Pipes+build-type:          Simple+cabal-version:       >=1.10+tested-with:         GHC == 7.10.3, GHC == 8.0.1++library+  hs-source-dirs:      src+  exposed-modules:     Pipes.Misc+  build-depends:       base >= 4.7 && < 5+                     , lens >= 4 && < 5+                     , mtl >= 2 && < 3+                     , pipes >= 4 && < 5+                     , pipes-category >= 0.2 && < 0.3+                     , pipes-concurrency >= 2 && < 3+                     , semigroups >= 0.18 && < 1+                     , stm >= 2.4 && < 3+                     , transformers >= 0.4 && < 0.6+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite pipes-misc-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base >= 4.7 && < 5+                     , lens >=4 &&< 5+                     , pipes >= 4 && < 5+                     , pipes-misc >= 0.2.0.0+                     , transformers >= 0.4 && < 0.6+                     , hspec >= 2 && < 3+  ghc-options:         -Wall -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/louispan/pipes-misc
+ src/Pipes/Misc.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}++-- | Miscellaneous utilities for pipes, required by glazier-tutorial+module Pipes.Misc where++import Control.Arrow+import qualified Control.Concurrent.STM as S+import Control.Lens+import Control.Monad+import Control.Monad.State.Strict+import Control.Monad.Trans.Maybe+import qualified Pipes as P+import qualified Pipes.Concurrent as PC+import qualified Pipes.Shaft as PS+import qualified Pipes.Prelude as PP+import qualified Data.List.NonEmpty as NE+import Control.Monad.Except+import Control.Applicative++-- | Like Pipes.Concurrent.fromInput, but stays in STM+fromInputSTM :: PC.Input a -> P.Producer' a S.STM ()+fromInputSTM as = void $ runMaybeT $ forever $ do+    a <- MaybeT $ lift $ PC.recv as+    lift $ P.yield a++-- | Like Pipes.Concurrent.toOutput, but stays in STM+toOutputSTM :: PC.Output a -> P.Consumer' a S.STM ()+toOutputSTM output = void $ runMaybeT $ forever $ do+    a <- lift P.await+    p <- lift $ lift $ PC.send output a+    guard p++-- | 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.+batch :: PC.Input a -> PC.Input (NE.NonEmpty a)+batch (PC.Input xs) = PC.Input $ do+    x <- xs+    case x of+        Nothing -> pure Nothing+        Just x' -> do+            xs' <- runExceptT . tryNext $ x' NE.:| []+            case xs' of+                Left ys -> pure (Just ys)+                Right ys -> pure (Just ys)+  where+      tryNext ys = do+          ys' <- ExceptT $ (tryCons ys <$> xs) <|> pure (Left ys)+          tryNext ys'+      tryCons ys x = case x of+          Nothing -> Left ys -- return successful reads so far+          Just x' -> Right $ x' NE.<| ys++-- | Given a size and a initial tail, create a pipe that+-- will buffer the output of a producer.+-- This pipe is stateful, and will only buffer until the immediate connecting+-- producer is finished.+-- @+-- forever $ do+--   a <- await+--   yield a >-> buffer 2 [] -- will only ever result a producer of single 'a : []'.+-- @+-- @+-- (forever $ do+--   a <- await+--   yield a+-- ) >-> buffer 2 [] -- will buffer properly and produce '[latest, old]'+-- @+buffer :: Monad m => Int -> [a] -> P.Pipe a [a] m r+buffer n as = do+  a <- P.await+  let as' = take n $ a : as+  case forceSpine as' of -- TODO: can we leave this lazy?+    () -> do+      P.yield as'+      buffer n as'+ where+  -- from https://ro-che.info/articles/2015-05-28-force-list+  forceSpine = foldr (const id) ()++-- | Store the output of the pipe into a MonadState.+store :: MonadState s m => Getter a b -> Setter' s b -> P.Pipe a a m r+store v s = forever $ do+  a <- P.await+  s .= view v a+  P.yield a++-- | Yields a view into the stored value.+retrieve :: MonadState s m => Getter s b -> P.Pipe a (b, a) m r+retrieve v = forever $ do+  a <- P.await+  s <- get+  P.yield (view v s, a)++-- | Run a pipe in a larger stream, using view function and modify function+-- of the larger stream.+locally ::+  Monad m =>+     (s -> a)+  -> (b -> s -> t)+  -> P.Pipe a b m r+  -> 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.>-> PP.map (uncurry modifyf)
+ test/Spec.hs view
@@ -0,0 +1,29 @@+module Main where++import Control.Lens+import Data.Foldable+import qualified Pipes as P+import qualified Pipes.Misc as PM+import qualified Pipes.Prelude as PP+import Test.Hspec++data1 :: [Int]+data1 = [1, 2..9]++sig1 :: Monad m => P.Producer Int m ()+sig1 = traverse_ P.yield data1++main :: IO ()+main = do+  hspec $ do+      describe "Misc" $ do+          it "Buffered" $ do+              let xs = PP.toList (sig1 P.>-> PM.buffer 2 [])+              xs `shouldBe` (pure $ head data1) : ((\(a, b) -> [a, b]) <$> zip (tail data1) data1)++          it "Locally +10 to second" $ do+              let xs = PP.toList+                       (sig1+                        P.>-> PP.map (\a -> (a, a))+                        P.>-> PM.locally (view _2) (set _2) (PP.map (+ 10)))+              xs `shouldBe` zip data1 ((+ 10) <$> data1)