chp-plus 1.2.0 → 1.3.0

raw patch · 5 files changed

+25/−37 lines, 5 filesdep −mtldep ~chpPVP ok

version bump matches the API change (PVP)

Dependencies removed: mtl

Dependency ranges changed: chp

API changes (from Hackage documentation)

Files

• Control/Concurrent/CHP/Arrow.hs +1/−12
• Control/Concurrent/CHP/Composed.hs +1/−5
• Control/Concurrent/CHP/Console.hs +8/−9
• Control/Concurrent/CHP/Test.hs +11/−7
• chp-plus.cabal +4/−4

@@ -65,15 +65,9 @@ -- I have got this module to work on GHC 6.8 and 6.10 by following the CPP-variant -- instructions on this page: http://haskell.org/haskellwiki/Upgrading_packages -#if __GLASGOW_HASKELL__ >= 609+import Control.Arrow import Control.Category import Prelude hiding ((.), id)-#endif--import Control.Arrow-#if __GLASGOW_HASKELL__ < 610-                      hiding (pure)-#endif import Control.DeepSeq import Control.Monad @@ -204,16 +198,11 @@ instance Functor (ProcessPipeline a) where   fmap f x = x >>> arr f -#if __GLASGOW_HASKELL__ >= 609 instance Category ProcessPipeline where   (ProcessPipeline q) . (ProcessPipeline p) = ProcessPipeline (p <=> q)   id = ProcessPipeline CHP.id-#endif  instance Arrow ProcessPipeline where-#if __GLASGOW_HASKELL__ < 609-  (ProcessPipeline p) >>> (ProcessPipeline q) = ProcessPipeline (p <=> q)-#endif   arr = ProcessPipeline . CHP.map    first (ProcessPipeline p) = ProcessPipeline $ \in_ out -> do

@@ -11,7 +11,7 @@ --  * 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+--  * Neither the name of the Neil Brown nor the names of other --    contributors may be used to endorse or promote products derived from --    this software without specific prior written permission. --@@ -71,7 +71,6 @@ 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@@ -88,9 +87,6 @@  instance MonadCHP Composed where   liftCHP x = Composed (x >>=)--instance MonadIO Composed where-  liftIO x = Composed (liftIO x >>=)  instance Functor Composed where   fmap = liftM

@@ -34,7 +34,6 @@ import Control.Concurrent.STM import qualified Control.Exception.Extensible as C import Control.Monad-import Control.Monad.Trans --import Data.Maybe import System.IO @@ -56,7 +55,7 @@ consoleProcess :: (ConsoleChans -> CHP ()) -> CHP () consoleProcess mainProc   = do [cin, cout, cerr] <- replicateM 3 oneToOneChannel-       tvs@[tvinId, tvoutId, tverrId] <- liftIO $ atomically $ replicateM 3 $ newTVar Nothing+       tvs@[tvinId, tvoutId, tverrId] <- liftIO_CHP $ atomically $ replicateM 3 $ newTVar Nothing        runParallel_          [ inHandler tvinId (writer cin)          , outHandler tvoutId stdout (reader cout)@@ -70,16 +69,16 @@               -- Poison won't do it if the handlers are blocked on input or               -- output.  Therefore we throw them an exception to "knock them               -- off" their current action and make them exit.-              liftIO yield-              liftIO $ mapM_ killThread ids+              liftIO_CHP yield+              liftIO_CHP $ mapM_ killThread ids          ]   where     getId :: TVar (Maybe a) -> CHP a-    getId tv = liftIO $ atomically $ readTVar tv >>= maybe retry return+    getId tv = liftIO_CHP $ atomically $ readTVar tv >>= maybe retry return      -- Like liftIO, but turns any caught exceptions into throwing poison     liftIO' :: IO a -> CHP a-    liftIO' m = liftIO (liftM Just m `C.catches` handlers)+    liftIO' m = liftIO_CHP (liftM Just m `C.catches` handlers)       >>= maybe throwPoison return       where         response :: C.Exception e => e -> IO (Maybe a)@@ -97,9 +96,9 @@          inHandler :: TVar (Maybe ThreadId) -> Chanout Char -> CHP ()     inHandler tv c-      = do liftIO $ myThreadId >>= atomically . writeTVar tv . Just+      = do liftIO_CHP $ myThreadId >>= atomically . writeTVar tv . Just            if rtsSupportsBoundThreads-             then (forever $ do ready <- liftIO $ hWaitForInput stdin 100+             then (forever $ do ready <- liftIO_CHP $ hWaitForInput stdin 100                                 checkForPoison c                                 when ready $                                   liftIO' getChar >>= writeChannel c)@@ -109,6 +108,6 @@      outHandler :: TVar (Maybe ThreadId) -> Handle -> Chanin Char -> CHP ()     outHandler tv h c-      = do liftIO $ myThreadId >>= atomically . writeTVar tv . Just+      = do liftIO_CHP $ myThreadId >>= atomically . writeTVar tv . Just            (forever $ readChannel c >>= liftIO' . hPutChar h)              `onPoisonTrap` poison c

@@ -35,8 +35,6 @@  import Control.Arrow import Control.Monad-import Control.Monad.Error (ErrorT, runErrorT, throwError)-import Control.Monad.Trans (MonadIO) import Data.Monoid import Data.Unique import Test.HUnit (assertFailure, Test(..))@@ -171,9 +169,15 @@                                ++ show t  -- | See withCheck.-newtype CHPTest a = CHPTest (ErrorT String CHP a)-  deriving (Monad, MonadIO, MonadCHP)+newtype CHPTest a = CHPTest {runCHPTest :: CHP (Either String a)} +instance Monad CHPTest where+  return = CHPTest . return . Right+  m >>= k = CHPTest $ runCHPTest m >>= either (return . Left) (runCHPTest . k)++instance MonadCHP CHPTest where+  liftCHP = CHPTest . liftM Right+ -- | A helper function that allows you to create CHP tests in an assertion style, either -- for use with HUnit or QuickCheck 2. --@@ -223,8 +227,8 @@ -- >                    poison (reader c) -- Shutdown myProc -- >                    assertCHPEqual' "1000 values" xs (replicate 1000 42) withCheck :: CHP a -> CHPTest () -> CHP CHPTestResult-withCheck p (CHPTest t) = liftM snd $ (p `onPoisonTrap` return undefined) <||> do-  er <- runErrorT t+withCheck p t = liftM snd $ (p `onPoisonTrap` return undefined) <||> do+  er <- runCHPTest t   case er of     Left msg -> return $ CHPTestFail msg     Right _ -> return CHPTestPass@@ -236,7 +240,7 @@ assertCHP :: CHP () -> String -> Bool -> CHPTest () assertCHP comp msg passed   | passed = return ()-  | otherwise = liftCHP comp >> CHPTest (throwError msg)+  | otherwise = liftCHP comp >> CHPTest (return $ Left msg)  -- | Checks that the given values are equal (first is the expected value of the -- test, second is the actual value).  If they are equal, the assertion passes and the

@@ -1,5 +1,5 @@ Name:            chp-plus-Version:         1.2.0+Version:         1.3.0 Synopsis:        A set of high-level concurrency utilities built on Communicating Haskell Processes License:         BSD3 License-file:    LICENSE@@ -18,7 +18,7 @@  Cabal-Version:   >= 1.2.3 Build-Type:      Simple-Build-Depends:   base >= 3 && < 5, chp >= 2.0 && < 2.2, containers, deepseq >= 1.1 && < 1.2, extensible-exceptions >= 0.1.1.0, HUnit, mtl, pretty, QuickCheck >= 2, stm+Build-Depends:   base >= 3 && < 5, chp >= 2.2 && < 2.3, containers, deepseq >= 1.1 && < 1.2, extensible-exceptions >= 0.1.1.0, HUnit, pretty, QuickCheck >= 2, stm  Exposed-modules: Control.Concurrent.CHP.Actions                  Control.Concurrent.CHP.Arrow@@ -31,8 +31,8 @@                  Control.Concurrent.CHP.Console                  Control.Concurrent.CHP.Test -Extensions:      CPP FlexibleInstances GeneralizedNewtypeDeriving-                 MultiParamTypeClasses ParallelListComp Rank2Types+Extensions:      CPP FlexibleInstances MultiParamTypeClasses+                 ParallelListComp Rank2Types                  ScopedTypeVariables TypeFamilies   GHC-Options:     -Wall -auto-all