diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,14 @@ [1]: http://semver.org/spec/v2.0.0.html [2]: https://github.com/roman/capataz/releases +## v0.2.1.0 + +* Support GHC-8.6.3. +* Deprecate `buildLogWorkerSpec` in favour of `buildLogWorkerSpec1` which takes + `Natural` instead of `Int` for compatibility with `stm-2.5`. +* Deprecate `buildLogWorkerOptions` in favour of `buildLogWorkerOptions1` which + takes `Natural` instead of `Int` for compatibility with `stm-2.5`. + ## v0.2.0.0 Bumblebee release **BREAKING CHANGES** diff --git a/capataz.cabal b/capataz.cabal --- a/capataz.cabal +++ b/capataz.cabal @@ -1,13 +1,13 @@ -cabal-version: >=1.10 +cabal-version: 1.12 name: capataz -version: 0.2.0.0 +version: 0.2.1.0 license: MIT license-file: LICENSE -copyright: © 2018 Roman Gonzalez +copyright: © 2018, 2019 Roman Gonzalez and Collaborators maintainer: open-source@roman-gonzalez.info author: Roman Gonzalez stability: alpha (experimental) -tested-with: ghc ==8.0.1 ghc ==8.0.2 ghc ==8.2.1 +tested-with: ghc ==8.0.1 ghc ==8.0.2 ghc ==8.2.1 ghc ==8.6.3 homepage: https://github.com/roman/Haskell-capataz#readme bug-reports: https://github.com/roman/Haskell-capataz/issues synopsis: OTP-like supervision trees in Haskell @@ -31,8 +31,8 @@ category: Control, Concurrency build-type: Simple extra-source-files: - CHANGELOG.md README.md + CHANGELOG.md source-repository head type: git @@ -52,6 +52,7 @@ Control.Concurrent.Capataz.Internal.Worker hs-source-dirs: src other-modules: + Capataz.HowTo.DynamicWorker Control.Concurrent.Capataz.Internal.Process Control.Concurrent.Capataz.Util Paths_capataz @@ -86,11 +87,11 @@ base ==4.*, bytestring >=0.10.8, capataz -any, - pretty-show >=1.7, + pretty-show >=1.9.5, prettyprinter >=1.1, rio >=0.1.2.0, - tasty >=1.0.1.1, - tasty-hunit >=0.10.0.1, + tasty >=1.2.2, + tasty-hunit >=0.10.0.2, tasty-smallcheck >=0.8.1, teardown >=0.5.0.0, time >=1.6.0, diff --git a/src/Capataz/HowTo/DynamicWorker.hs b/src/Capataz/HowTo/DynamicWorker.hs new file mode 100644 --- /dev/null +++ b/src/Capataz/HowTo/DynamicWorker.hs @@ -0,0 +1,78 @@ +{-# OPTIONS_GHC -Wno-warnings-deprecations #-} +{-# LANGUAGE OverloadedStrings #-} +module Capataz.HowTo.DynamicWorker + ( + -- * Description + -- $description + + -- * Code + -- $code + main + ) where + +import RIO +import Capataz + ( + forkCapataz + , forkWorker + , terminateCapataz_ + , buildWorkerOptions + , workerRestartStrategyL + , WorkerRestartStrategy(..) + , onSystemEventL + ) + +{- $description + +The following example: + +* creates a capataz system +* forks a worker process dynamically +* terminates capataz system + +-} + +{- $code + +@ +module Capataz.HowTo.DynamicWorker + +myUselessWorker :: IO () +myUselessWorker = return () + +main :: IO () +main = do + bracket + ('forkCapataz' \"dynamic-worker-example\" + (set 'onSystemEventL' traceDisplayIO)) + 'terminateCapataz_' + (\\capataz -> do + void $ 'forkWorker' + ( 'buildWorkerOptions' \"useless-worker\" + myUselessWorker + (set 'workerRestartStrategyL' 'Transient') + ) + capataz + threadDelay 1001000) +@ + +-} + +myUselessWorker :: IO () +myUselessWorker = return () + +-- | Function that runs the example +main :: IO () +main = do + bracket + (forkCapataz "dynamic-worker-example" + (set onSystemEventL traceDisplayIO)) + terminateCapataz_ + (\capataz -> do + void $ forkWorker + ( buildWorkerOptions "useless-worker" + myUselessWorker + (set workerRestartStrategyL Transient) + ) + capataz + threadDelay 1001000) diff --git a/src/Control/Concurrent/Capataz.hs b/src/Control/Concurrent/Capataz.hs --- a/src/Control/Concurrent/Capataz.hs +++ b/src/Control/Concurrent/Capataz.hs @@ -38,10 +38,12 @@ , Control.Concurrent.Capataz.Internal.Types.buildSupervisorOptions , Control.Concurrent.Capataz.Internal.Types.buildSupervisorOptionsWithDefaults , Control.Concurrent.Capataz.Internal.Types.buildWorkerOptions +, Control.Concurrent.Capataz.Internal.Types.buildWorkerOptions1 , Control.Concurrent.Capataz.Internal.Types.buildWorkerOptionsWithDefaults , Control.Concurrent.Capataz.Internal.Types.supervisorSpec , Control.Concurrent.Capataz.Internal.Types.supervisorSpecWithDefaults , Control.Concurrent.Capataz.Internal.Types.workerSpec +, Control.Concurrent.Capataz.Internal.Types.workerSpec1 , Control.Concurrent.Capataz.Internal.Types.workerSpecWithDefaults -- * Lenses to modify Option Records diff --git a/src/Control/Concurrent/Capataz/Util.hs b/src/Control/Concurrent/Capataz/Util.hs --- a/src/Control/Concurrent/Capataz/Util.hs +++ b/src/Control/Concurrent/Capataz/Util.hs @@ -2,7 +2,9 @@ {-# LANGUAGE NoImplicitPrelude #-} module Control.Concurrent.Capataz.Util ( - buildLogWorkerSpec + buildLogWorkerSpec1 + , buildLogWorkerSpec + , buildLogWorkerOptions1 , buildLogWorkerOptions ) where @@ -63,15 +65,15 @@ -- threadDelay 1000100 -- @ -- --- @since 0.2.0.0 -buildLogWorkerSpec +-- @since 0.2.1.0 +buildLogWorkerSpec1 :: (MonadUnliftIO m, MonadIO m0) => LogOptions -- ^ options for the 'LogFunc' instance -> WorkerName -- ^ name of the logger worker process - -> Int -- ^ how many log messages can be in-flight when writer is slow? + -> Natural -- ^ how many log messages can be in-flight when writer is slow? -> (WorkerOptions m -> WorkerOptions m) -- ^ worker process modifier -> m0 (ProcessSpec m, LogFunc) -buildLogWorkerSpec logOptions procName bufferSize modOptions = do +buildLogWorkerSpec1 logOptions procName bufferSize modOptions = do inputQueue <- newTBQueueIO bufferSize let myLogFunc = mkLogFunc $ \lmCallStack lmLogSource lmLogLevel lmPayload -> atomically @@ -87,6 +89,23 @@ return (loggerSpec, myLogFunc) +-- | Deprecated in favour of 'buildLogWorkerSpec1'. +-- +-- __IMPORTANT__ Since 0.2.1.0 this function throws a runtime error if +-- the argumet of the type 'Int' is negative. +-- +-- @since 0.2.0.0 +buildLogWorkerSpec + :: (MonadUnliftIO m, MonadIO m0) + => LogOptions -- ^ options for the 'LogFunc' instance + -> WorkerName -- ^ name of the logger worker process + -> Int -- ^ how many log messages can be in-flight when writer is slow? + -> (WorkerOptions m -> WorkerOptions m) -- ^ worker process modifier + -> m0 (ProcessSpec m, LogFunc) +buildLogWorkerSpec logOptions procName bufferSize = + buildLogWorkerSpec1 logOptions procName (fromIntegral bufferSize) +{-# DEPRECATED buildLogWorkerSpec "Use buildLogWorkerSpec1 instead" #-} + -- | Builds a 'WorkerOptions' record that spawns a thread that logs messages -- written with the returned 'LogFunc'. Use this function if you want to build a -- logger thread dynamically via 'forkWorker'. @@ -116,15 +135,15 @@ -- threadDelay 1000100 -- @ -- --- @since 0.2.0.0 -buildLogWorkerOptions +-- @since 0.2.1.0 +buildLogWorkerOptions1 :: (MonadUnliftIO m, MonadIO m0) => LogOptions -> WorkerName - -> Int + -> Natural -> (WorkerOptions m -> WorkerOptions m) -> m0 (WorkerOptions m, LogFunc) -buildLogWorkerOptions logOptions procName bufferSize modOptions = do +buildLogWorkerOptions1 logOptions procName bufferSize modOptions = do inputQueue <- newTBQueueIO bufferSize let myLogFunc = mkLogFunc $ \lmCallStack lmLogSource lmLogLevel lmPayload -> atomically @@ -139,3 +158,20 @@ (modOptions . set workerRestartStrategyL Permanent) return (loggerSpec, myLogFunc) + +-- | Deprecated in favour of 'buildLogWorkerOptions1'. +-- +-- __IMPORTANT__ Since 0.2.1.0 this function throws a runtime error if +-- the argumet of the type 'Int' is negative. +-- +-- @since 0.2.0.0 +buildLogWorkerOptions + :: (MonadUnliftIO m, MonadIO m0) + => LogOptions + -> WorkerName + -> Int + -> (WorkerOptions m -> WorkerOptions m) + -> m0 (WorkerOptions m, LogFunc) +buildLogWorkerOptions logOptions procName bufferSize = + buildLogWorkerOptions1 logOptions procName (fromIntegral bufferSize) +{-# DEPRECATED buildLogWorkerOptions "Use buildLogWorkerOptions1 instead" #-}