pipes-courier (empty) → 0.1.0.0
raw patch · 4 files changed
+248/−0 lines, 4 filesdep +basedep +courierdep +pipessetup-changed
Dependencies added: base, courier, pipes
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- pipes-courier.cabal +41/−0
- src/Pipes/Courier.hs +175/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Kyle Van Berendonck++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Kyle Van Berendonck nor the names of other+ 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+OWNER 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-courier.cabal view
@@ -0,0 +1,41 @@++name: pipes-courier+version: 0.1.0.0+synopsis: Pipes utilities for interfacing with the courier message-passing framework.+homepage: http://github.com/kvanberendonck/pipes-courier+license: BSD3+license-file: LICENSE+author: Kyle Van Berendonck+maintainer: kvanberendonck@gmail.com+copyright: 2014 Kyle Van Berendonck+category: Pipes+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10+description:+ Pipes utilities for interfacing with the @courier@ message-passing framework.+ This package implements shortcut fusion for both pushing and pulling streams.++source-repository head+ type: git+ location: git://github.com/kvanberendonck/pipes-courier.git++library+ default-language: Haskell2010+ hs-source-dirs: src++ exposed-modules:+ Pipes.Courier++ build-depends:+ base >= 4 && < 4.8,+ courier >= 0.1.0.8 && < 0.1.1,+ pipes >= 4.0 && < 4.2++ default-extensions:+ Rank2Types++ other-extensions:+ Trustworthy++ ghc-options: -O2 -Wall
+ src/Pipes/Courier.hs view
@@ -0,0 +1,175 @@++{-# LANGUAGE Trustworthy #-}++-- | @pipes@ utilities for interfacing with the @courier@ message-passing framework.+module Pipes.Courier+ ( -- * Endpoints+ -- $endpoints+ send+ , send'+ , broadcast+ , post+ , receive+ , receiveTimeout+ , receiveTimeout'+ , select+ , selectTimeout+ , selectTimeout'++ -- * Re-exports+ -- $reexports+ , module Network.Endpoints+ ) where++import Data.Function+import Network.Endpoints+import Pipes+++{- $endpoints+ + Pipes which operate on 'Endpoint's.+-}++{- | @send ep name@ sends the message supplied upstream through the given 'Endpoint' @ep@ to the+ 'Name' @name@.++ Analogous to 'sendMessage_'.+-}+send :: MonadIO m => Endpoint -> Name -> Consumer' Message m r+send ep name = for cat $ \m -> liftIO (sendMessage_ ep name m)+{-# INLINABLE send #-}++{-# RULES+ "p >-> send" forall p ep name .+ p >-> send ep name = for p (\m -> liftIO (sendMessage_ ep name m))+ #-}++{- | @send' ep name@ is like @send@ except the pipe closes if an error occurs while finding a+ suitable 'Transport'.+-}+send' :: MonadIO m => Endpoint -> Name -> Consumer' Message m ()+send' ep name = for cat $ \m -> fix $ \f ->+ liftIO (sendMessage ep name m) >>= \x -> case x of { Left _ -> return (); _ -> f }+{-# INLINABLE send' #-}++{-# RULES+ "p >-> send'" forall p ep name .+ p >-> send' ep name = for p $ \m -> fix $ \f ->+ liftIO (sendMessage ep name m) >>= \x -> case x of { Left _ -> return (); _ -> f }+ #-}++{- | @broadcast ep names@ sends the message supplied upstream through the given 'Endpoint' @ep@ to+ the 'Name's specified in the list of @names@.++ Analogous to 'broadcastMessage_'.+-}+broadcast :: MonadIO m => Endpoint -> [Name] -> Consumer' Message m r+broadcast ep names = for cat $ \m -> liftIO (broadcastMessage_ ep names m)+{-# INLINABLE broadcast #-}++{-# RULES+ "p >-> broadcast" forall p ep names .+ p >-> broadcast ep names = for p (\m -> liftIO (broadcastMessage_ ep names m))+ #-}++{- | @post ep@ posts the message supplied by upstream to the given 'Endpoint' @ep@ without using a+ transport.++ Analogous to 'postMessage'.+-}+post :: MonadIO m => Endpoint -> Consumer' Message m r+post ep = for cat $ \m -> liftIO (postMessage ep m)+{-# INLINABLE post #-}++{-# RULES+ "p >-> post" forall p ep .+ p >-> post ep = for p (\m -> liftIO (postMessage ep m))+ #-}++{- | @receive ep@ forwards the next message available from the given 'Endpoint' @ep@ downstream.+ + Analogous to 'receiveMessage'.+-}+receive :: MonadIO m => Endpoint -> Producer' Message m r+receive ep = liftIO (receiveMessage ep) >~ cat+{-# INLINABLE receive #-}++{-# RULES+ "receive ep >-> p" forall ep p .+ receive ep >-> p = liftIO (receiveMessage ep) >~ p+ #-}++{- | @receiveTimeout ep tout@ is like 'receive' except operates using a timeout. If a message becomes+ available before the given timeout then downstream will receive a 'Just', otherwise it will+ receive 'Nothing' (but the pipe will remain open).++ Analogous to 'receiveMessageTimeout'.+-}+receiveTimeout :: MonadIO m => Endpoint -> Int -> Producer' (Maybe Message) m r+receiveTimeout ep tout = liftIO (receiveMessageTimeout ep tout) >~ cat+{-# INLINABLE receiveTimeout #-}++{-# RULES+ "receiveTimeout ep tout >-> p" forall ep tout p .+ receiveTimeout ep tout >-> p = liftIO (receiveMessageTimeout ep tout) >~ p+ #-}++{- | @receiveTimeout' ep tout@ is like 'receiveTimeout' except the pipe closes if no messages are+ received within the timeout period.+-}+receiveTimeout' :: MonadIO m => Endpoint -> Int -> Producer' Message m ()+receiveTimeout' ep tout = go+ where+ go = do+ msg <- liftIO $ receiveMessageTimeout ep tout+ case msg of+ Just m -> yield m >> go+ Nothing -> return ()+{-# INLINABLE receiveTimeout' #-}++{- | @select ep f@ takes all of the messages available from the given 'Endpoint' @ep@ and applies+ them to the function @f@. Messages will only be sent downstream if @f@ returns 'Just'.++ Analogous to 'selectMessage'.+-}+select :: MonadIO m => Endpoint -> (Message -> Maybe v) -> Producer' v m r+select ep f = liftIO (selectMessage ep f) >~ cat+{-# INLINABLE select #-}++{-# RULES+ "select ep f >-> p" forall ep f p .+ select ep f >-> p = liftIO (selectMessage ep f) >~ p+ #-}++{- | @selectTimeout ep tout f@ is like 'select' except operates using a timeout. If a message is + selected before the given timeout then downstream will receive a 'Just', otherwise it will+ receive 'Nothing' (but the pipe will remain open).++ Analogous to 'selectMessageTimeout'.+-}+selectTimeout :: MonadIO m => Endpoint -> Int -> (Message -> Maybe v) -> Producer' (Maybe v) m r+selectTimeout ep tout f = liftIO (selectMessageTimeout ep tout f) >~ cat+{-# INLINABLE selectTimeout #-}++{-# RULES+ "selectTimeout ep tout f >-> p" forall ep tout f p .+ selectTimeout ep tout f >-> p = liftIO (selectMessageTimeout ep tout f) >~ p+ #-}++{- | @selectTimeout' ep tout f@ is like 'selectTimeout' except the pipe closes if no messages are+ received within the timeout period.+-}+selectTimeout' :: MonadIO m => Endpoint -> Int -> (Message -> Maybe v) -> Producer' v m ()+selectTimeout' ep tout f = go+ where+ go = do+ msg <- liftIO $ selectMessageTimeout ep tout f+ case msg of+ Just m -> yield m >> go+ Nothing -> return ()+{-# INLINABLE selectTimeout' #-}+++-- $reexports+