chp-plus 1.1.0 → 1.2.0

raw patch · 4 files changed

+191/−44 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Concurrent/CHP/Composed.hs +160/−0
• Control/Concurrent/CHP/Connect.hs +27/−40
• Control/Concurrent/CHP/Test.hs +0/−1
• chp-plus.cabal +4/−3

@@ -0,0 +1,160 @@+-- Communicating Haskell Processes.+-- Copyright (c) 2009-2010, Neil Brown.+-- 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 the University of Kent 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 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.++-- | A module containing a 'Composed' monad.+--+-- The 'Composed' monad can be thought of as an equivalent to functions elsewhere+-- in chp-plus (especially the "Control.Concurrent.CHP.Connect" module) that support+-- partial application of processes when wiring them up.+--+-- Binding in this monad can be thought of as \"and then wire that like this\".+--  You compose your processes together with a series of monadic actions, feeding+-- processes into each function that wires up the next parameter, then taking the+-- results of that action and further wiring it up another way.  At the end of+-- the monadic block you should return the full list of wired-up processes, to+-- be run in parallel using the 'run' (or 'run_') functions.+--+-- Here is a simple example.  You have a list of processes that take an incoming+-- and outgoing channel end and a barrier, and you want to wire them into a cycle+-- and enroll them all on the barrier:+--+-- > processes :: [Chanin a -> Chanout a -> EnrolledBarrier -> CHP ()]+-- >+-- > runProcesses = do b <- newBarrier+-- >                   run $ cycleR processes >>= enrollAllR b+--+-- The order of the actions in this monad tends not to matter (it is a commutative+-- monad for the most part) so you could equally have written:+--+-- > processes :: [EnrolledBarrier -> Chanin a -> Chanout a -> CHP ()]+-- >+-- > runProcesses = do b <- newBarrier+-- >                   run $ enrollAllR b processes >>= cycleR+--+-- Remember with this monad to return all the processes to be run in parallel;+-- if they are not returned, they will not be run and you will likely get deadlock.+--+-- A little more background on the monad is available in this blog post: <http://chplib.wordpress.com/2010/01/19/the-process-composition-monad/>+module Control.Concurrent.CHP.Composed+  (Composed, runWith, run, run_, enrollR, enrollAllR, connectR, pipelineR, pipelineCompleteR, cycleR,+    wrappedGridFourR)+    where++import Control.Applicative+import Control.Concurrent.CHP+import Control.Concurrent.CHP.Connect+import Control.Concurrent.CHP.Connect.TwoDim (FourWay(..))+import Control.Monad+import Control.Monad.Trans+import Data.List (transpose)++-- | A monad for composing together CHP processes in cross-cutting ways; e.g. wiring+-- together a list of processes into a pipeline, but also enrolling them all on+-- a barrier.+newtype Composed a = Composed {+  runWith :: forall b. (a -> CHP b) -> CHP b+  -- ^ See 'run' and 'run_'+  }++instance Monad Composed where+  return x = Composed ($ x)+  (>>=) m f = Composed (\r -> m `runWith` ((`runWith` r) . f))++instance MonadCHP Composed where+  liftCHP x = Composed (x >>=)++instance MonadIO Composed where+  liftIO x = Composed (liftIO x >>=)++instance Functor Composed where+  fmap = liftM++instance Applicative Composed where+  pure = return+  (<*>) = ap++-- | Given a list of CHP processes composed using the Composed monad, runs them+-- as a parallel bunch of CHP results (with 'runParallel') and returns the results.+run :: Composed [CHP a] -> CHP [a]+run p = p `runWith` runParallel++-- | Like 'run' but discards the results (uses 'runParallel_').+run_ :: Composed [CHP a] -> CHP ()+run_ p = p `runWith` runParallel_++-- | Like 'enroll', this takes a barrier and a process wanting a barrier, and enrolls+-- it for the duration, but operates using the 'Composed' monad.+enrollR :: Enrollable b p => b p -> (Enrolled b p -> a) -> Composed a+enrollR b p = Composed (\r -> enroll b (r . p))++-- | Given an 'Enrollable' item (such as a 'Barrier'), and a list of processes,+-- composes them by enrolling them all on the given barrier.+enrollAllR :: Enrollable b p => b p -> [Enrolled b p -> a] -> Composed [a]+enrollAllR b ps = Composed (\r -> enrollAllT r (return b) ps)++-- | Like 'connect' but operates in the 'Composed' monad.+connectR :: Connectable l r => ((l, r) -> a) -> Composed a+connectR p = Composed (\r -> connect (r . p))++-- | Wires a list of processes into a pipeline that takes the two channels for+-- the ends of the pipeline and returns the list of wired-up processes.+pipelineR :: Connectable l r => [r -> l -> a] -> Composed (r -> l -> [a])+pipelineR [] = return $ const $ const []+pipelineR (first:rest) = foldM pcr (\x y -> [first x y]) rest+  where+    pcr p q = connectR $ \(l, r) x y -> (p x l) ++ [q r y]++-- Similar to 'pipelineR' but puts a process at the beginning and end of the pipeline.+--  The list is returned in the order @[start] ++ middle ++ [end]@.+pipelineCompleteR :: Connectable l r => (l -> a) -> [r -> l -> a] -> (r -> a) -> Composed [a]+pipelineCompleteR start middle end+  = do midWired <- pipelineR middle+       startAndMiddle <- connectR $ \(l, r) e -> start l : midWired r e+       connectR $ \(l, r) -> startAndMiddle l ++ [end r]++-- | Connects together a list of processes into a cycle.+cycleR :: Connectable l r => [r -> l -> a] -> Composed [a]+cycleR [] = return []+cycleR [p] = (:[]) <$> connectR (uncurry $ flip p)+cycleR ps = pipelineR ps >>= connectR . uncurry . flip++-- | Like 'wrappedGridFour', but in the 'Composed' monad.+wrappedGridFourR :: (Connectable below above, Connectable right left) =>+  [[FourWay above below left right -> a]] -> Composed [[a]]+wrappedGridFourR = (return . transpose) <=< mapM cycleR <=< (return . transpose) <=< mapM (connectRowR)+  where+--    connectRowR :: [FourWay above below left right -> a] -> [below -> above -> a]+    connectRowR ps = cycleR [\l r a b -> p (FourWay a b l r) | p <- ps]++--wrappedGridFourR' :: (Connectable below above, Connectable right left) =>+--  [[above -> below -> left -> right -> a]] -> Composed [[a]]+--wrappedGridFourR' = (mapM cycleConnectR . transpose) <=< (mapM cycleConnectR . transpose)+--  where+--    connectRowR :: [FourWay above below left right -> a] -> [below -> above -> a]+--    connectRowR ps = cycleConnectR [\l r a b -> p (FourWay a b l r) | p <- ps]

@@ -30,7 +30,7 @@ -- | A module of operators for connecting processes together. module Control.Concurrent.CHP.Connect   (Connectable(..), (<=>), (|<=>), (<=>|), (|<=>|), pipelineConnect, pipelineConnectComplete,-    pipelineConnectCompleteT, cycleConnect, connectList, connectList_, ChannelPair,+    cycleConnect, connectList, connectList_, ChannelPair,     ConnectableExtra(..), connectWith) where  import Control.Applicative@@ -42,9 +42,9 @@ -- -- The API (and name) for this is still in flux, so do not rely on it just yet. class ConnectableExtra l r where-  type ConnectableParam l+  type ConnectableParam l r   -- | Runs the given code with the two items connected.-  connectExtra :: ConnectableParam l -> ((l, r) -> CHP ()) -> CHP ()+  connectExtra :: ConnectableParam l r -> ((l, r) -> CHP ()) -> CHP ()  -- | Indicates that its two parameters can be joined together automatically. --@@ -86,7 +86,7 @@ (|<=>|) :: Connectable l r => (l -> CHP ()) -> (r -> CHP ()) -> CHP () (|<=>|) p q = connect $ \(x, y) -> p x <|*|> q y -jpo :: ConnectableExtra l r => ConnectableParam l -> (l -> CHP ()) -> (r -> CHP ()) -> CHP ()+jpo :: ConnectableExtra l r => ConnectableParam l r -> (l -> CHP ()) -> (r -> CHP ()) -> CHP () jpo o p q = connectExtra o $ \(x, y) -> p x <|*|> q y  -- | Joins together the given two processes and runs them in parallel.@@ -102,7 +102,7 @@ (|<=>) p q x = p |<=>| flip q x  -- | Like '(<=>)' but with 'ConnectableExtra'-connectWith :: ConnectableExtra l r => ConnectableParam l ->+connectWith :: ConnectableExtra l r => ConnectableParam l r ->   (a -> l -> CHP ()) -> (r -> b -> CHP ()) -> a -> b -> CHP () connectWith o p q x y = jpo o (p x) (flip q y) @@ -120,19 +120,6 @@ pipelineConnectComplete begin middle end   = (foldl (|<=>) begin middle) |<=>| end --- | Like 'pipelineConnectComplete' but allows a customised function to run all--- the processes in parallel.  So @pipelineConnectCompleteT runParallel@ is the--- same as @pipelineConnectComplete@.  The list of items given to the first function--- will be in the order: begin process, middle processes, end process, as you would--- expect.-pipelineConnectCompleteT :: Connectable l r =>-  ([a] -> CHP b) -> (l -> a) -> [r -> l -> a] -> (r -> a) -> CHP b-pipelineConnectCompleteT run begin [] end-  = connect $ \(l, r) -> run [begin l, end r]-pipelineConnectCompleteT run begin (p:ps) end-  = connect $ \(l, r) ->-      pipelineConnectCompleteT (run . (begin l :)) (p r) ps end- -- | Like 'pipelineConnect' but also connects the last process into the first. --  If the list is empty, it returns immediately. cycleConnect :: Connectable l r => [r -> l -> CHP ()] -> CHP ()@@ -142,13 +129,13 @@ instance Connectable (Chanout a) (Chanin a) where   connect = (newChannelWR >>=) instance ConnectableExtra (Chanout a) (Chanin a) where-  type ConnectableParam (Chanout a) = ChanOpts a+  type ConnectableParam (Chanout a) (Chanin a) = ChanOpts a   connectExtra o = (>>=) ((writer &&& reader) <$> oneToOneChannel' o)  instance Connectable (Chanin a) (Chanout a) where   connect = (newChannelRW >>=) instance ConnectableExtra (Chanin a) (Chanout a) where-  type ConnectableParam (Chanin a) = ChanOpts a+  type ConnectableParam (Chanin a) (Chanout a) = ChanOpts a   connectExtra o = (>>=) ((reader &&& writer) <$> oneToOneChannel' o)  instance Connectable (Shared Chanin a) (Chanout a) where connect = (newChannelRW >>=)@@ -160,23 +147,23 @@ instance Connectable (Shared Chanout a) (Shared Chanin a) where connect = (newChannelWR >>=)  instance ConnectableExtra (Chanout a) (Shared Chanin a) where-  type ConnectableParam (Chanout a) = ChanOpts a+  type ConnectableParam (Chanout a) (Shared Chanin a) = ChanOpts a   connectExtra o = (>>=) ((writer &&& reader) <$> oneToAnyChannel' o) instance ConnectableExtra (Shared Chanout a) (Chanin a) where-  type ConnectableParam (Shared Chanout a) = ChanOpts a+  type ConnectableParam (Shared Chanout a) (Chanin a) = ChanOpts a   connectExtra o = (>>=) ((writer &&& reader) <$> anyToOneChannel' o) instance ConnectableExtra (Shared Chanout a) (Shared Chanin a) where-  type ConnectableParam (Shared Chanout a) = ChanOpts a+  type ConnectableParam (Shared Chanout a) (Shared Chanin a) = ChanOpts a   connectExtra o = (>>=) ((writer &&& reader) <$> anyToAnyChannel' o)  instance ConnectableExtra (Shared Chanin a) (Chanout a) where-  type ConnectableParam (Shared Chanin a) = ChanOpts a+  type ConnectableParam (Shared Chanin a) (Chanout a) = ChanOpts a   connectExtra o = (>>=) ((reader &&& writer) <$> oneToAnyChannel' o) instance ConnectableExtra (Chanin a) (Shared Chanout a) where-  type ConnectableParam (Chanin a) = ChanOpts a+  type ConnectableParam (Chanin a) (Shared Chanout a) = ChanOpts a   connectExtra o = (>>=) ((reader &&& writer) <$> anyToOneChannel' o) instance ConnectableExtra (Shared Chanin a) (Shared Chanout a) where-  type ConnectableParam (Shared Chanin a) = ChanOpts a+  type ConnectableParam (Shared Chanin a) (Shared Chanout a) = ChanOpts a   connectExtra o = (>>=) ((reader &&& writer) <$> anyToAnyChannel' o)  @@ -187,7 +174,7 @@                  enroll b $ \b0 -> enroll b $ \b1 -> m (b0, b1)  instance ConnectableExtra (Enrolled PhasedBarrier ph) (Enrolled PhasedBarrier ph) where-  type ConnectableParam (Enrolled PhasedBarrier ph) = (ph, BarOpts ph)+  type ConnectableParam (Enrolled PhasedBarrier ph) (Enrolled PhasedBarrier ph) = (ph, BarOpts ph)   connectExtra (ph, o) m     = do b <- newPhasedBarrier' ph o          enroll b $ \b0 -> enroll b $ \b1 -> m (b0, b1)@@ -196,7 +183,7 @@ instance (Connectable al ar, Connectable bl br) => Connectable (al, bl) (ar, br) where   connect m = connect $ \(ax, ay) -> connect $ \(bx, by) -> m ((ax, bx), (ay, by)) instance (ConnectableExtra al ar, ConnectableExtra bl br) => ConnectableExtra (al, bl) (ar, br) where-  type ConnectableParam (al, bl) = (ConnectableParam al, ConnectableParam bl)+  type ConnectableParam (al, bl) (ar, br) = (ConnectableParam al ar, ConnectableParam bl br)   connectExtra (ao, bo) m = connectExtra ao $ \(ax, ay) -> connectExtra bo $ \(bx, by) -> m ((ax, bx), (ay, by))  instance (Connectable al ar, Connectable bl br, Connectable cl cr) =>@@ -206,7 +193,7 @@  instance (ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr) =>   ConnectableExtra (al, bl, cl) (ar, br, cr) where-  type ConnectableParam (al, bl, cl) = (ConnectableParam al, ConnectableParam bl, ConnectableParam cl)+  type ConnectableParam (al, bl, cl) (ar, br, cr) = (ConnectableParam al ar, ConnectableParam bl br, ConnectableParam cl cr)   connectExtra (ao, bo, co) m     = connectExtra ao $ \(ax, ay) -> connectExtra bo $ \(bx, by) ->       connectExtra co $ \(cx, cy) -> m ((ax, bx, cx), (ay, by, cy))@@ -220,11 +207,11 @@ instance (ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr,           ConnectableExtra dl dr) =>           ConnectableExtra (al, bl, cl, dl) (ar, br, cr, dr) where-  type ConnectableParam (al, bl, cl, dl)-    = (ConnectableParam al,-       ConnectableParam bl,-       ConnectableParam cl,-       ConnectableParam dl)+  type ConnectableParam (al, bl, cl, dl) (ar, br, cr, dr)+    = (ConnectableParam al ar,+       ConnectableParam bl br,+       ConnectableParam cl cr,+       ConnectableParam dl dr)   connectExtra (ao, bo, co, do_) m     = connectExtra ao $ \(ax, ay) -> connectExtra bo $ \(bx, by) ->       connectExtra co $ \(cx, cy) -> connectExtra do_ $ \(dx, dy) ->@@ -239,12 +226,12 @@ instance (ConnectableExtra al ar, ConnectableExtra bl br, ConnectableExtra cl cr,           ConnectableExtra dl dr, ConnectableExtra el er) =>           ConnectableExtra (al, bl, cl, dl, el) (ar, br, cr, dr, er) where-  type ConnectableParam (al, bl, cl, dl, el)-    = (ConnectableParam al,-       ConnectableParam bl,-       ConnectableParam cl,-       ConnectableParam dl,-       ConnectableParam el)+  type ConnectableParam (al, bl, cl, dl, el) (ar, br, cr, dr, er)+    = (ConnectableParam al ar,+       ConnectableParam bl br,+       ConnectableParam cl cr,+       ConnectableParam dl dr,+       ConnectableParam el er)   connectExtra (ao, bo, co, do_, eo) m     = connectExtra ao $ \(ax, ay) -> connectExtra bo $ \(bx, by) ->       connectExtra co $ \(cx, cy) -> connectExtra do_ $ \(dx, dy) ->

@@ -37,7 +37,6 @@ import Control.Monad import Control.Monad.Error (ErrorT, runErrorT, throwError) import Control.Monad.Trans (MonadIO)-import Data.Maybe import Data.Monoid import Data.Unique import Test.HUnit (assertFailure, Test(..))

@@ -1,5 +1,5 @@ Name:            chp-plus-Version:         1.1.0+Version:         1.2.0 Synopsis:        A set of high-level concurrency utilities built on Communicating Haskell Processes License:         BSD3 License-file:    LICENSE@@ -25,13 +25,14 @@                  Control.Concurrent.CHP.Behaviours                  Control.Concurrent.CHP.Buffers                  Control.Concurrent.CHP.Common+                 Control.Concurrent.CHP.Composed                  Control.Concurrent.CHP.Connect                  Control.Concurrent.CHP.Connect.TwoDim                  Control.Concurrent.CHP.Console                  Control.Concurrent.CHP.Test  Extensions:      CPP FlexibleInstances GeneralizedNewtypeDeriving-                 MultiParamTypeClasses ParallelListComp ScopedTypeVariables-                 TypeFamilies+                 MultiParamTypeClasses ParallelListComp Rank2Types+                 ScopedTypeVariables TypeFamilies   GHC-Options:     -Wall -auto-all