immortal-worker (empty) → 0.1.0.0

raw patch · 6 files changed

+142/−0 lines, 6 filesdep +basedep +deepseqdep +immortalsetup-changed

Dependencies added: base, deepseq, immortal, monad-logger, safe-exceptions, text, unliftio-core

Files

• CHANGELOG.md +3/−0
• LICENSE +20/−0
• README.md +3/−0
• Setup.hs +2/−0
• immortal-worker.cabal +43/−0
• src/Control/Immortal/Worker.hs +71/−0

@@ -0,0 +1,3 @@+# 0.1.0.0++* Initial release

@@ -0,0 +1,20 @@+Copyright (c) 2020 Anton Gushcha++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,3 @@+# immortal-worker++Small library to create immortal worker threads with exception safety.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,43 @@+name:                immortal-worker+version:             0.1.0.0+synopsis:            Create worker threads that logs exceptions and restarts.+description:+  The package provides means for common pattern in web development in Haskell.+  When you need a thread that makes some task in a loop with sleeping between+  iterations you don't wan't it to die from some occasional exception.+  .+  So, the package contains:+  .+    * Helper to create non-dying labeled threads with logging of occured exceptions.+      Only synchronous exceptions are considered as safe for restoring from. Delay is+      added between respawns of worker.+  .+    * Isolation helpers for subactions that should not interfere with each other.++build-type:          Simple+cabal-version:       >=1.10+license:             MIT+license-file:        LICENSE+copyright:           2020 Anton Gushcha+maintainer:          Anton Gushcha <ncrashed@protonmail.com>+category:            Concurrency+extra-source-files:+    README.md+    CHANGELOG.md++library+  hs-source-dirs:      src+  exposed-modules:+      Control.Immortal.Worker+  build-depends:+        base                   >= 4.7  && < 4.15+      , deepseq                >= 1.4  && < 1.5+      , immortal               >= 0.3  && < 0.4+      , monad-logger           >= 0.3  && < 0.4+      , safe-exceptions        >= 0.1  && < 0.2+      , text                   >= 1.2  && < 1.3+      , unliftio-core          >= 0.1  && < 0.2+  default-language:    Haskell2010+  default-extensions:+    OverloadedStrings+    ScopedTypeVariables

@@ -0,0 +1,71 @@+{-|+Module      : Control.Immortal.Worker+Description : Immortal thread with logging and restart on exceptions.+Copyright   : (c) Anton Gushcha (ncrashed), 2020+License     : MIT+Maintainer  : ncrashed@gmail.com+Stability   : experimental+Portability : Portable++Here is a longer description of this module, containing some+commentary with @some markup@.++Typical usage:++@+worker "supervisor" $ const $ forever $ do+  logInfoN "Supervisor started"+  let subworkers = [+          subworker1+        , subworker2+        ]+  traverse_ (isolate_ "subworker") subworkers+  liftIO $ threadDelay 10_000_000+@++-}+module Control.Immortal.Worker(+    workerWith+  , worker+  , isolate+  , isolate_+  ) where++import Control.Concurrent (threadDelay)+import Control.DeepSeq+import Control.Exception.Safe (SomeException, catchDeep)+import Control.Monad.IO.Unlift+import Control.Monad.Logger+import Data.Text (pack)++import qualified Control.Immortal as I++-- | Start immortal worker that logs on exceptions and restarts.+--+-- Note that action is not looped implicitly. Add 'Control.Monad.forever' into action+-- manually to achive this.+workerWith :: (MonadUnliftIO m, MonadLogger m)+  => (String -> SomeException -> m ()) -- ^ Action to perform before worker restart+  -> String -- ^ Worker label for thred+  -> (I.Thread -> m ()) -- ^ Worker action (no looping is added)+  -> m I.Thread+workerWith logthem lbl f = I.createWithLabel lbl $ \thread ->+  I.onUnexpectedFinish thread (either (logthem lbl) (const $ pure ())) (f thread)++-- | Helper that starts new immortal thread with logging of errors+worker :: (MonadUnliftIO m, MonadLogger m) => String -> (I.Thread -> m ()) -> m I.Thread+worker = workerWith $ \lbl e -> do+  logErrorN $ "Worker " <> pack lbl <> " exit with: " <> (pack . show) e+  liftIO $ threadDelay 1000000++-- | If computation fails, print log and return default value.+isolate :: (MonadUnliftIO m, MonadLogger m, NFData a) => String -> a -> m a -> m a+isolate title a0 ma = do+  run <- askRunInIO+  liftIO $ catchDeep (run ma) $ \(e :: SomeException) -> run $ do+    logErrorN $ "Isolated action " <> pack title <> " failed: " <> (pack . show) e+    pure a0++-- | Same as `isolate` but returns empty tuple+isolate_ :: (MonadUnliftIO m, MonadLogger m) => String -> m () -> m ()+isolate_ lbl = isolate lbl ()