capataz 0.1.0.0 → 0.1.0.1
raw patch · 12 files changed
+162/−107 lines, 12 filesdep ~asyncPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: async
API changes (from Hackage documentation)
+ Control.Concurrent.Capataz.Internal.Types: [$sel:supervisorName:CapatazOptions] :: CapatazOptions -> !SupervisorName
- Control.Concurrent.Capataz: buildWorkerOptions :: WorkerName -> (IO ()) -> (WorkerOptions -> WorkerOptions) -> WorkerOptions
+ Control.Concurrent.Capataz: buildWorkerOptions :: WorkerName -> IO () -> (WorkerOptions -> WorkerOptions) -> WorkerOptions
- Control.Concurrent.Capataz: buildWorkerOptionsWithDefaults :: WorkerName -> (IO ()) -> WorkerOptions
+ Control.Concurrent.Capataz: buildWorkerOptionsWithDefaults :: WorkerName -> IO () -> WorkerOptions
- Control.Concurrent.Capataz: forkCapataz :: (CapatazOptions -> CapatazOptions) -> IO Capataz
+ Control.Concurrent.Capataz: forkCapataz :: Text -> (CapatazOptions -> CapatazOptions) -> IO Capataz
- Control.Concurrent.Capataz: workerSpec :: WorkerName -> (IO ()) -> (WorkerOptions -> WorkerOptions) -> ProcessSpec
+ Control.Concurrent.Capataz: workerSpec :: WorkerName -> IO () -> (WorkerOptions -> WorkerOptions) -> ProcessSpec
- Control.Concurrent.Capataz: workerSpecWithDefaults :: WorkerName -> (IO ()) -> ProcessSpec
+ Control.Concurrent.Capataz: workerSpecWithDefaults :: WorkerName -> IO () -> ProcessSpec
- Control.Concurrent.Capataz.Internal.Core: forkCapataz :: (CapatazOptions -> CapatazOptions) -> IO Capataz
+ Control.Concurrent.Capataz.Internal.Core: forkCapataz :: Text -> (CapatazOptions -> CapatazOptions) -> IO Capataz
- Control.Concurrent.Capataz.Internal.Types: CapatazOptions :: !Int -> !NominalDiffTime -> !SupervisorRestartStrategy -> ![ProcessSpec] -> !ProcessTerminationOrder -> !(IO ()) -> !(SomeException -> IO ()) -> !(CapatazEvent -> IO ()) -> CapatazOptions
+ Control.Concurrent.Capataz.Internal.Types: CapatazOptions :: !SupervisorName -> !Int -> !NominalDiffTime -> !SupervisorRestartStrategy -> ![ProcessSpec] -> !ProcessTerminationOrder -> !(IO ()) -> !(SomeException -> IO ()) -> !(CapatazEvent -> IO ()) -> CapatazOptions
- Control.Concurrent.Capataz.Internal.Types: buildWorkerOptions :: WorkerName -> (IO ()) -> (WorkerOptions -> WorkerOptions) -> WorkerOptions
+ Control.Concurrent.Capataz.Internal.Types: buildWorkerOptions :: WorkerName -> IO () -> (WorkerOptions -> WorkerOptions) -> WorkerOptions
- Control.Concurrent.Capataz.Internal.Types: buildWorkerOptionsWithDefaults :: WorkerName -> (IO ()) -> WorkerOptions
+ Control.Concurrent.Capataz.Internal.Types: buildWorkerOptionsWithDefaults :: WorkerName -> IO () -> WorkerOptions
- Control.Concurrent.Capataz.Internal.Types: defCapatazOptions :: (CapatazOptions -> CapatazOptions) -> CapatazOptions
+ Control.Concurrent.Capataz.Internal.Types: defCapatazOptions :: Text -> (CapatazOptions -> CapatazOptions) -> CapatazOptions
- Control.Concurrent.Capataz.Internal.Types: workerSpec :: WorkerName -> (IO ()) -> (WorkerOptions -> WorkerOptions) -> ProcessSpec
+ Control.Concurrent.Capataz.Internal.Types: workerSpec :: WorkerName -> IO () -> (WorkerOptions -> WorkerOptions) -> ProcessSpec
- Control.Concurrent.Capataz.Internal.Types: workerSpecWithDefaults :: WorkerName -> (IO ()) -> ProcessSpec
+ Control.Concurrent.Capataz.Internal.Types: workerSpecWithDefaults :: WorkerName -> IO () -> ProcessSpec
Files
- CHANGELOG.md +35/−0
- README.md +7/−4
- capataz.cabal +3/−3
- src/Control/Concurrent/Capataz.hs +1/−1
- src/Control/Concurrent/Capataz/Internal/Core.hs +14/−15
- src/Control/Concurrent/Capataz/Internal/Supervisor.hs +12/−6
- src/Control/Concurrent/Capataz/Internal/Types.hs +31/−34
- src/Control/Concurrent/Capataz/Internal/Util.hs +2/−3
- src/Control/Concurrent/Capataz/Internal/Worker.hs +5/−1
- test/testsuite/Control/Concurrent/Capataz/SupervisorTest.hs +21/−19
- test/testsuite/Control/Concurrent/CapatazTest.hs +21/−16
- test/testsuite/Test/Util.hs +10/−5
CHANGELOG.md view
@@ -6,6 +6,41 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/capataz/releases +## v0.1.0.1++* Bump bounds of `async` dependency++## v0.1.0.0 Who supervises the supervisor?++**BREAKING CHANGES**++* Introduction of the `Process` type which is composed of both `Supervisor` and+ `Worker` types+* Replace `defWorkerSpec` in favor of `workerSpec` and `workerSpecWithDefaults`+ to build static workers+* Replace of `defWorkerOptions` in favor of `buildWorkerOptions` and+ `buildWorkerOptionsWithDefaults` to build dynamic workers+* Replace `terminateWorker` in favor of `terminateProcess`+* Add `supervisorSpec`, `supervisorSpecWithDefaults` to build static supervision+ trees+* Add `forkSupervisor`, `buildSupervisorOptions` and+ `buildSupervisorOptionsWithDefaults` to build dynamic supervision trees+* Replace usage of default records semantics in favor of Lenses+* Add `joinCapatazThread` to avoid providing direct access to async of root+ supervision tree+* Add `getSupervisorProcessId` to access the `ProcessId` of a given `Supervisor`+ record (for dynamic termination)+* Add `getSupervisorAsync` to access the `Async ()` record of a supervisor+ process thread+* Add `getCapatazTeardown` to access the `Teardown` record of the capataz system+* Move `CapatazEvent` records to new module `Control.Concurrent.Capataz.Event`+ to avoid requiring `DuplicateRecordFields` extension on API users+* Remove `WorkerAction` alias as it is used for library development+ documentation+* Add capataz-repo-watcher example to showcase static supervision trees+* Update capataz-simple-example unix-process example+* `forkCapataz` signature now requires name for root supervisor+ ## v0.0.0.2 * Bump bounds of `tasty` dependency
README.md view
@@ -8,7 +8,7 @@ * [Documentation](#documentation) * [Development](#development) -## Raison d'etre+## Raison d'être As time progresses, I've come to love developing concurrent applications in Haskell, its API (STM, MVars, etc.) and light threading RTS bring a lot to the@@ -91,12 +91,15 @@ ## Development [](https://travis-ci.org/roman/Haskell-capataz)-[](https://img.shields.io/github/commits-since/roman/haskell-capataz/v0.0.0.2.svg)+[](https://img.shields.io/github/commits-since/roman/haskell-capataz/v0.1.0.0.svg) [](http://packdeps.haskellers.com/feed?needle=capataz) Follow the [developer guidelines](https://romanandreg.gitbooks.io/capataz/content/developer-guidelines.html) -## In next release+## In future releases -* Add support for supervising supervisors+* Replace Protolude in favor of RIO+* Documentation of performance analysis+* Documentation improvements+* capataz-dashboard package that provides web-ui with Supervisor statistics * Ensure unit tests always finish on all concurrent scenarios (dejafu experiment)
capataz.cabal view
@@ -1,5 +1,5 @@ name: capataz-version: 0.1.0.0+version: 0.1.0.1 cabal-version: >=1.10 build-type: Simple license: MIT@@ -50,7 +50,7 @@ Control.Concurrent.Capataz.Internal.Util Control.Concurrent.Capataz.Internal.Worker build-depends:- async >=2.1.1.1 && <2.2,+ async >=2.1.1.1 && <2.3, base >=4.10.1.0 && <4.11, bytestring >=0.10.8.2 && <0.11, data-default >=0.7.1.1 && <0.8,@@ -75,7 +75,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs build-depends:- async >=2.1.1.1 && <2.2,+ async >=2.1.1.1 && <2.3, base >=4.10.1.0 && <4.11, bytestring >=0.10.8.2 && <0.11, capataz -any,
src/Control/Concurrent/Capataz.hs view
@@ -81,6 +81,6 @@ import qualified Control.Concurrent.Capataz.Internal.Core import qualified Control.Concurrent.Capataz.Internal.Types+import Control.Concurrent.Capataz.Lens ((&), (.~)) import qualified Control.Concurrent.Capataz.Lens import qualified Control.Teardown-import Control.Concurrent.Capataz.Lens ((.~), (&))
src/Control/Concurrent/Capataz/Internal/Core.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+ {-| This module contains: * Functions exported on the public API@@ -26,8 +27,7 @@ import Protolude import Control.Concurrent.MVar (newEmptyMVar, takeMVar)-import Control.Teardown (newTeardown)-import Control.Teardown (Teardown)+import Control.Teardown (Teardown, newTeardown) import Data.Time.Clock (getCurrentTime) import qualified Data.UUID.V4 as UUID (nextRandom)@@ -46,7 +46,7 @@ getSupervisor :: a -> Supervisor instance HasSupervisor Capataz where- getSupervisor (Capataz {capatazSupervisor}) = capatazSupervisor+ getSupervisor Capataz {capatazSupervisor} = capatazSupervisor instance HasSupervisor Supervisor where getSupervisor = identity@@ -55,12 +55,13 @@ -- "Teardown" to shut down the system. The root supervisor monitors failures on -- process threads defined with "supervisorProcessSpecList" or created -- dynamically using "forkWorker" or "forkSupervisor".-forkCapataz :: (CapatazOptions -> CapatazOptions) -> IO Capataz-forkCapataz modOptionsFn = do+forkCapataz :: Text -> (CapatazOptions -> CapatazOptions) -> IO Capataz+forkCapataz capatazName modOptionsFn = do capatazId <- UUID.nextRandom supervisorId <- UUID.nextRandom let- capatazOptions@CapatazOptions { notifyEvent } = defCapatazOptions modOptionsFn+ capatazOptions@CapatazOptions { notifyEvent } =+ defCapatazOptions capatazName modOptionsFn supervisorOptions@SupervisorOptions { supervisorName } = Util.capatazOptionsToSupervisorOptions capatazOptions parentSupervisorEnv = ParentSupervisorEnv@@ -92,7 +93,6 @@ ControlAction{} -> panic "Capataz received a ControlAction message; bad implementation"- , notifyEvent } @@ -187,7 +187,7 @@ joinCapatazThread :: Capataz -> IO () joinCapatazThread Capataz { capatazSupervisor } = let Supervisor { supervisorAsync } = capatazSupervisor- in wait supervisorAsync+ in wait supervisorAsync -- | Gets "Teardown" record of this capataz system. getCapatazTeardown :: Capataz -> Teardown@@ -198,8 +198,7 @@ -- NOTE: There is no way to get the "Async" value of the root supervisor; this -- is to avoid error scenarios. getSupervisorAsync :: Supervisor -> Async ()-getSupervisorAsync Supervisor { supervisorAsync } =- supervisorAsync+getSupervisorAsync Supervisor { supervisorAsync } = supervisorAsync -- | Gets the process identifier of a Supervisor; normally used for termination. getSupervisorProcessId :: Supervisor -> ProcessId
src/Control/Concurrent/Capataz/Internal/Supervisor.hs view
@@ -90,8 +90,10 @@ handleControlAction :: SupervisorEnv -> ControlAction -> IO Bool handleControlAction env controlAction = case controlAction of ForkWorker { workerOptions, returnWorkerId } -> do- worker@Worker { workerId } <-- Worker.forkWorker (Util.toParentSupervisorEnv env) workerOptions Nothing+ worker@Worker { workerId } <- Worker.forkWorker+ (Util.toParentSupervisorEnv env)+ workerOptions+ Nothing Util.appendProcessToMap env (WorkerProcess worker) returnWorkerId workerId return True@@ -241,7 +243,10 @@ supervisorProcessSpecList ( \processSpec -> case processSpec of WorkerSpec workerOptions -> do- worker <- Worker.forkWorker (Util.toParentSupervisorEnv supervisorEnv) workerOptions Nothing+ worker <- Worker.forkWorker+ (Util.toParentSupervisorEnv supervisorEnv)+ workerOptions+ Nothing Util.appendProcessToMap supervisorEnv (WorkerProcess worker) SupervisorSpec childSupervisorOptions -> do@@ -409,9 +414,10 @@ restartWorker :: SupervisorEnv -> WorkerOptions -> WorkerId -> RestartCount -> IO Process restartWorker supervisorEnv workerOptions workerId restartCount =- WorkerProcess <$> Worker.forkWorker (Util.toParentSupervisorEnv supervisorEnv)- workerOptions- (Just (workerId, restartCount))+ WorkerProcess <$> Worker.forkWorker+ (Util.toParentSupervisorEnv supervisorEnv)+ workerOptions+ (Just (workerId, restartCount)) -- | Starts a new Supervisor thread taking into account an existing -- "SupervisorId" and keeping a "RestartCount" to manage the parent Supervisor
src/Control/Concurrent/Capataz/Internal/Types.hs view
@@ -2,19 +2,19 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE OverloadedStrings #-}+ {-| This module contains all the types used across all the other modules -} module Control.Concurrent.Capataz.Internal.Types where import Protolude -import Control.Concurrent.STM.TVar (TVar)-import Control.Teardown (ITeardown (..), Teardown)-import Data.Default (Default (..))-import Data.HashMap.Strict (HashMap)-import Data.IORef (IORef)-import Data.Time.Clock (NominalDiffTime, UTCTime)-import Data.UUID (UUID)+import Control.Concurrent.STM.TVar (TVar)+import Control.Teardown (ITeardown (..), Teardown)+import Data.Default (Default (..))+import Data.HashMap.Strict (HashMap)+import Data.IORef (IORef)+import Data.Time.Clock (NominalDiffTime, UTCTime)+import Data.UUID (UUID) type CapatazId = UUID type WorkerId = UUID@@ -212,7 +212,8 @@ -- data CapatazOptions = CapatazOptions {- supervisorIntensity :: !Int+ supervisorName :: !SupervisorName+ , supervisorIntensity :: !Int , supervisorPeriodSeconds :: !NominalDiffTime , supervisorRestartStrategy :: !SupervisorRestartStrategy , supervisorProcessSpecList :: ![ProcessSpec]@@ -530,21 +531,20 @@ -- This function is intended to be used in combination with "forkCapataz". -- defCapatazOptions- :: (CapatazOptions -> CapatazOptions) -- ^ Function to modify root supervisor- -- options+ :: Text+ -> (CapatazOptions -> CapatazOptions) -- ^ Function to modify root supervisor -> CapatazOptions-defCapatazOptions modFn =- modFn CapatazOptions- {- supervisorIntensity = 2- , supervisorPeriodSeconds = 5- , supervisorRestartStrategy = def- , supervisorProcessSpecList = []- , supervisorProcessTerminationOrder = OldestFirst- , supervisorOnIntensityReached = return ()- , supervisorOnFailure = const $ return ()- , notifyEvent = const $ return ()- }+defCapatazOptions supervisorName modFn = modFn CapatazOptions+ { supervisorName+ , supervisorIntensity = 2+ , supervisorPeriodSeconds = 5+ , supervisorRestartStrategy = def+ , supervisorProcessSpecList = []+ , supervisorProcessTerminationOrder = OldestFirst+ , supervisorOnIntensityReached = return ()+ , supervisorOnFailure = const $ return ()+ , notifyEvent = const $ return ()+ } -- | Builds a "ProcessSpec" record for a supervisor process with defaults from -- "supervisorSpecWithDefaults". This function allows overrides of these@@ -570,9 +570,8 @@ -- supervisorSpecWithDefaults :: SupervisorName -- ^ Name used for telemetry purposes- -> ProcessSpec-supervisorSpecWithDefaults sName =- supervisorSpec sName identity+ -> ProcessSpec+supervisorSpecWithDefaults sName = supervisorSpec sName identity {-# INLINE supervisorSpecWithDefaults #-} -- | Builds a "ProcessSpec" record for a worker process with defaults from@@ -583,7 +582,7 @@ -- workerSpec :: WorkerName -- ^ Name used for telemetry purposes- -> (IO ()) -- ^ IO sub-routine to be supervised+ -> IO () -- ^ IO sub-routine to be supervised -> (WorkerOptions -> WorkerOptions) -- ^ Function to modify default worker -- options -> ProcessSpec@@ -598,10 +597,9 @@ -- workerSpecWithDefaults :: WorkerName -- ^ Name used for telemetry purposes- -> (IO ()) -- ^ IO sub-routine to be supervised+ -> IO () -- ^ IO sub-routine to be supervised -> ProcessSpec-workerSpecWithDefaults wName wAction =- workerSpec wName wAction identity+workerSpecWithDefaults wName wAction = workerSpec wName wAction identity {-# INLINE workerSpecWithDefaults #-} -- | Builds a "SupervisorOptions" record with defaults from@@ -641,8 +639,7 @@ buildSupervisorOptionsWithDefaults :: SupervisorName -- ^ Name used for telemetry purposes -> SupervisorOptions-buildSupervisorOptionsWithDefaults =- flip buildSupervisorOptions identity+buildSupervisorOptionsWithDefaults = flip buildSupervisorOptions identity {-# INLINE buildSupervisorOptionsWithDefaults #-} -- | Builds a "WorkerOptions" record, keeps the defaults from@@ -653,7 +650,7 @@ -- buildWorkerOptions :: WorkerName -- ^ Name used for telemetry purposes- -> (IO ()) -- ^ IO sub-routine to be supervised+ -> IO () -- ^ IO sub-routine to be supervised -> (WorkerOptions -> WorkerOptions) -- ^ Function to modify default worker -- options -> WorkerOptions@@ -687,7 +684,7 @@ -- buildWorkerOptionsWithDefaults :: WorkerName -- ^ Name used for telemetry purposes- -> (IO ()) -- ^ IO sub-routine to be supervised+ -> IO () -- ^ IO sub-routine to be supervised -> WorkerOptions buildWorkerOptionsWithDefaults wName wAction = buildWorkerOptions wName wAction identity
src/Control/Concurrent/Capataz/Internal/Util.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-| This module contains: @@ -163,8 +163,7 @@ -- | Utility function to transform a "CapatazOptions" record to a -- "SupervisorOptions" record. capatazOptionsToSupervisorOptions :: CapatazOptions -> SupervisorOptions-capatazOptionsToSupervisorOptions CapatazOptions {..} =- SupervisorOptions {supervisorName = "capataz-root-supervisor", ..}+capatazOptionsToSupervisorOptions CapatazOptions {..} = SupervisorOptions {..} -- | Utility function to transform a "SupervisorEnv" record to a -- "ParentSupervisorEnv" record; used on functions where supervision of
src/Control/Concurrent/Capataz/Internal/Worker.hs view
@@ -21,7 +21,11 @@ -- | Decorates the given @IO ()@ sub-routine with failure handling workerMain- :: ParentSupervisorEnv -> WorkerOptions -> WorkerId -> RestartCount -> IO Worker+ :: ParentSupervisorEnv+ -> WorkerOptions+ -> WorkerId+ -> RestartCount+ -> IO Worker workerMain env@ParentSupervisorEnv { supervisorNotify } workerOptions@WorkerOptions { workerName, workerAction } workerId restartCount = do workerCreationTime <- getCurrentTime
test/testsuite/Control/Concurrent/Capataz/SupervisorTest.hs view
@@ -21,17 +21,22 @@ SUT.supervisorProcessSpecListL [ SUT.supervisorSpec "tree-1"- ( set SUT.supervisorProcessSpecListL- [ SUT.workerSpecWithDefaults "1-A" (forever $ threadDelay 10001000)- , SUT.workerSpecWithDefaults "1-B" (forever $ threadDelay 10001000)+ ( set+ SUT.supervisorProcessSpecListL+ [ SUT.workerSpecWithDefaults "1-A"+ (forever $ threadDelay 10001000)+ , SUT.workerSpecWithDefaults "1-B"+ (forever $ threadDelay 10001000) ] ) , SUT.supervisorSpec "tree-2" ( set SUT.supervisorProcessSpecListL- [ SUT.workerSpecWithDefaults "2-A" (forever $ threadDelay 10001000)- , SUT.workerSpecWithDefaults "2-B" (forever $ threadDelay 10001000)+ [ SUT.workerSpecWithDefaults "2-A"+ (forever $ threadDelay 10001000)+ , SUT.workerSpecWithDefaults "2-B"+ (forever $ threadDelay 10001000) ] ) ]@@ -51,7 +56,7 @@ , assertSupervisorStatusChanged SUT.Initializing SUT.Running ] , andP- [ assertSupervisorName "capataz-root-supervisor"+ [ assertRootSupervisor , assertEventType SupervisorStatusChanged , assertSupervisorStatusChanged SUT.Initializing SUT.Running ]@@ -59,24 +64,19 @@ (const $ return ()) [] [ andP- [ assertSupervisorName "capataz-root-supervisor"+ [ assertRootSupervisor , assertEventType SupervisorStatusChanged , assertSupervisorStatusChanged SUT.Running SUT.Halting ]- , andP- [ assertSupervisorName "capataz-root-supervisor"- , assertEventType ProcessTerminationStarted- ]+ , andP [assertRootSupervisor, assertEventType ProcessTerminationStarted] , andP [assertSupervisorName "tree-1", assertWorkerTerminated "1-A"] , andP [assertSupervisorName "tree-1", assertWorkerTerminated "1-B"] , andP [assertSupervisorName "tree-2", assertWorkerTerminated "2-A"] , andP [assertSupervisorName "tree-2", assertWorkerTerminated "2-B"] , andP- [ assertSupervisorName "capataz-root-supervisor"- , assertEventType ProcessTerminationFinished- ]+ [assertRootSupervisor, assertEventType ProcessTerminationFinished] , andP- [ assertSupervisorName "capataz-root-supervisor"+ [ assertRootSupervisor , assertEventType SupervisorStatusChanged , assertSupervisorStatusChanged SUT.Halting SUT.Halted ]@@ -91,8 +91,9 @@ "tree-1" ( set SUT.supervisorIntensityL 1 . set SUT.supervisorPeriodSecondsL 10- . set SUT.supervisorProcessSpecListL- [SUT.workerSpecWithDefaults "failing-worker" failingAction]+ . set+ SUT.supervisorProcessSpecListL+ [SUT.workerSpecWithDefaults "failing-worker" failingAction] ) ] )@@ -116,8 +117,9 @@ "tree-1" ( set SUT.supervisorIntensityL 1 . set SUT.supervisorPeriodSecondsL 10- . set SUT.supervisorProcessSpecListL- [SUT.workerSpecWithDefaults "failing-worker" failingAction]+ . set+ SUT.supervisorProcessSpecListL+ [SUT.workerSpecWithDefaults "failing-worker" failingAction] ) , SUT.supervisorSpec "tree-2"
test/testsuite/Control/Concurrent/CapatazTest.hs view
@@ -288,8 +288,8 @@ capataz void $ SUT.terminateProcess "testing onFailure callback"- workerId- capataz+ workerId+ capataz ) [assertEventType ProcessTerminated] []@@ -350,9 +350,10 @@ ) capataz - void $ SUT.terminateProcess "testing workerOnTermination callback"- workerId- capataz+ void $ SUT.terminateProcess+ "testing workerOnTermination callback"+ workerId+ capataz ) [ andP [ assertEventType ProcessCallbackExecuted@@ -380,9 +381,10 @@ ) capataz - void $ SUT.terminateProcess "testing workerOnTermination callback"- workerId- capataz+ void $ SUT.terminateProcess+ "testing workerOnTermination callback"+ workerId+ capataz ) [ andP [ assertEventType ProcessCallbackExecuted@@ -447,9 +449,10 @@ ) capataz - void $ SUT.terminateProcess "testing workerOnTermination callback"- workerId- capataz+ void $ SUT.terminateProcess+ "testing workerOnTermination callback"+ workerId+ capataz ) [ andP [ assertEventType ProcessCallbackExecuted@@ -594,7 +597,9 @@ (set SUT.workerRestartStrategyL SUT.Permanent) ) capataz- void $ SUT.terminateProcess "testing termination (1)" workerId capataz+ void $ SUT.terminateProcess "testing termination (1)"+ workerId+ capataz ) [assertEventType ProcessTerminated, assertEventType ProcessRestarted] []@@ -621,12 +626,12 @@ capataz void $ SUT.terminateProcess "testing termination (1)"- workerId- capataz+ workerId+ capataz waitWorkerTermination 1 void $ SUT.terminateProcess "testing termination (2)"- workerId- capataz+ workerId+ capataz waitWorkerTermination 2 ) [ assertEventType ProcessTerminated
test/testsuite/Test/Util.hs view
@@ -209,6 +209,13 @@ assertCapatazFailedWith errorName = andP [assertEventType CapatazFailed, assertErrorType errorName] +rootSupervisorName :: Text+rootSupervisorName = "capataz-root-supervisor"++assertRootSupervisor :: SUT.CapatazEvent -> Bool+assertRootSupervisor = assertSupervisorName rootSupervisorName++ -------------------------------------------------------------------------------- -- | Exception used to test failures inside Worker sub-routines@@ -293,11 +300,9 @@ [preSetupAssertion, postSetupAssertions, postTeardownAssertions] ) - capataz <-- SUT.forkCapataz- ( SUT.set SUT.onSystemEventL (trackEvent accRef eventStream)- . optionModFn- )+ capataz <- SUT.forkCapataz+ rootSupervisorName+ (SUT.set SUT.onSystemEventL (trackEvent accRef eventStream) . optionModFn) -- We check preSetup assertions are met before we execute the setup -- function. This serves to test initialization of capataz instance