Control-Engine 0.0.4 → 0.0.6

raw patch · 2 files changed

+32/−32 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control-Engine.cabal +2/−1
• Control/Engine.hs +30/−31

@@ -1,5 +1,5 @@ name:		Control-Engine-version:	0.0.4+version:	0.0.6 license:	BSD3 license-file:	LICENSE author:		Thomas DuBuisson <thomas.dubuisson@gmail.com>@@ -8,6 +8,7 @@ 		of features in the Engine, to include dynamically adjustable hooks, 		managed state, and injection points. synopsis:	A parallel producer/consumer engine (thread pool)+homepage:	http://www.haskell.org/haskellwiki/Control-Engine category:	Control stability:	stable build-type:	Simple

@@ -1,6 +1,7 @@ {-| Implemented here is a thread pool library on crack.  -  1.0 Introduction+  /1.0 Introduction/+   Typically, a thread pool is a set of execution contexts that will execute   tasks from an input queue.  Typically, thread pools are used to parallize   the processing of incoming work across all available CPUs without going@@ -11,10 +12,12 @@   queue, producing an output queue, but also include hooks, task injection, and   state management. -  Queues :: (Chan a)-  From "Control.Concurrent.Chan".  -  Hooks :: (a -> IO Maybe a)+  /Queues :: (Chan a)/ - from "Control.Concurrent.Chan".+++  /Hooks :: (a -> IO Maybe a)/+   Hooks can be added and removed during execution without creating a new   engine. They allow the developer to modify tasks: @@ -25,8 +28,11 @@    * in parallel, after mutation function     * post parallization (for sequential post processing)++  -  State Management+  /State Management/+   The stateManager waits for any updates to the mutator state or hooks.  If any   modifications are made then the new set of hooks (or state) is provided   to the workers.  Correctness is handled by keeping the master copies as TVars@@ -37,8 +43,11 @@   contention action while the need for this information will be constant   and performance critical.  How successful this stratagy is has yet to   be shown.++  -  Injection+  /Injection/+   One injection point allows injection of a result that had no preceding   task.  The second injector allows the initial hooks ('Input' hooks) to be   bypassed.@@ -53,7 +62,6 @@ 	, Engine(..) 	-- * Hooks 	, Hook(..)-	, HookLoc(..) 	, addInputHook 	, addOutputHook 	, addPreMutateHook@@ -153,15 +161,13 @@ 	forkIO $ inputManager input c1 eref 	forkIO $ outputManager output c2 eref 	forkIO $ stateManager engine eref-	forM_ [1..nrWorkers] $ \_ -> forkIO $ worker c1 eref mutator c2+	forM_ [1..nrWorkers] $ \_ -> forkIO (worker c1 eref mutator c2) 	return engine  worker :: Chan job -> RefEngine job result st -> (st -> job -> IO (Maybe result)) -> Chan result -> IO ()-worker c1 eref mutator c2 = forever $ worker'+worker c1 eref mutator c2 = forever $ readChan c1 >>= worker'   where-  worker' = do-	-- Get next message, newest hooks, and state-	msg    <- readChan c1+  worker' msg = do 	preMH  <- readIORef (refPreMutateHook eref) 	postMH <- readIORef (refPostMutateHook eref) 	st     <- readIORef (refState eref)@@ -179,30 +185,25 @@   runStage stage (Just a) = stage a  stateManager :: (Eq st) => Engine job result st -> RefEngine job result st -> IO ()-stateManager eng eref = do-	curr <- atomically $ do-			s  <- readTVar (state eng)-			ih <- readTVar (tvInHook eng)-			eh <- readTVar (tvPreMutateHook eng)-			th <- readTVar (tvPostMutateHook eng)-			oh <- readTVar (tvOutHook eng)-			return (s,ih, eh, th, oh)-	updateState curr+stateManager eng eref = atomically readState >>= updateState   where-  updateState (s, ih, eh, th, oh) = do+  readState = do+		s  <- readTVar (state eng)+		ih <- readTVar (tvInHook eng)+		eh <- readTVar (tvPreMutateHook eng)+		th <- readTVar (tvPostMutateHook eng)+		oh <- readTVar (tvOutHook eng)+		return (s,ih, eh, th, oh)+  updateState curr@(s, ih, eh, th, oh) = do 	writeIORef (refState eref) s 	writeIORef (refInHook eref) ih 	writeIORef (refPreMutateHook eref) eh 	writeIORef (refPostMutateHook eref) th 	writeIORef (refOutHook eref) oh 	new <- atomically $ do-		s'  <- readTVar (state eng)-		ih' <- readTVar (tvInHook eng)-		eh' <- readTVar (tvPreMutateHook eng)-		th' <- readTVar (tvPostMutateHook eng)-		oh' <- readTVar (tvOutHook eng)-		when (s' == s && ih' == ih && eh' == eh && th' == th && oh' == oh) retry-		return (s', ih', eh', th', oh')+		x <- readState+		when (x == curr) retry+		return x 	updateState new  -- Input.hs@@ -247,8 +248,6 @@ instance Show (Hook a s) where 	show (Hk _ p d) = d ++ " Priority = " ++ (show p) 	showsPrec _ (Hk _ p d) = (++) ("Hk { hkFunc = undefined, p = " ++ (show p) ++ " , hkDescription = " ++ d ++ " } ")--data HookLoc = InputHook | PreMutateHook | PostMutateHook | OutputHook deriving (Eq, Ord, Show)  runHooks :: [Hook st msg] -> st -> msg -> IO (Maybe msg) runHooks hooks st m = foldM apply (Just m) hooks