watchdog 0.2.3 → 0.3
raw patch · 3 files changed
+75/−64 lines, 3 filesdep ~base
Dependency ranges changed: base
Files
- Control/Watchdog.hs +72/−61
- LICENSE +1/−1
- watchdog.cabal +2/−2
Control/Watchdog.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- How to use: --@@ -85,6 +86,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Control.Watchdog ( watchdog+ , watchdogBlank , watch , watchImpatiently , setInitialDelay@@ -93,6 +95,7 @@ , setResetDuration , setLoggingAction , defaultLogger+ , showLogger , silentLogger , formatWatchdogError , WatchdogLogger@@ -102,88 +105,91 @@ import Control.Applicative import Control.Concurrent import Control.Monad.State.Strict+import Data.Monoid ((<>))+import Data.String (IsString, fromString) import Data.Time -data WatchdogState = WatchdogState { wcInitialDelay :: Int- , wcMaximumDelay :: Int- , wcResetDuration :: Int- , wcMaximumRetries :: Integer- , wcLoggingAction :: WatchdogLogger- }+data WatchdogState e = WatchdogState { wcInitialDelay :: Int+ , wcMaximumDelay :: Int+ , wcResetDuration :: Int+ , wcMaximumRetries :: Integer+ , wcLoggingAction :: WatchdogLogger e+ } -data WatchdogTaskStatus a = FailedImmediately String- | FailedAfterAWhile String- | CompletedSuccessfully a+data WatchdogTaskStatus e a = FailedImmediately e+ | FailedAfterAWhile e+ | CompletedSuccessfully a -newtype WatchdogAction a = WA { runWA :: StateT WatchdogState IO a }- deriving ( Functor, Applicative, Alternative- , Monad, MonadIO, MonadState WatchdogState)+newtype WatchdogAction e a = WA { runWA :: StateT (WatchdogState e) IO a }+ deriving ( Functor, Applicative, Alternative+ , Monad, MonadIO, MonadState (WatchdogState e)) -- | Type synonym for a watchdog logger.-type WatchdogLogger = String -- ^ Error message returned by the task.- -> Maybe Int -- ^ Waiting time - if any - before trying again.- -> IO ()+type WatchdogLogger e = e -- ^ Error value returned by the task.+ -> Maybe Int -- ^ Waiting time - if any - before trying again.+ -> IO () -defaultConf :: WatchdogState-defaultConf = WatchdogState { wcInitialDelay = 1 * 10 ^ (6::Integer)- , wcMaximumDelay = 300 * 10 ^ (6::Integer)- , wcMaximumRetries = 10- , wcResetDuration = 30 * 10 ^ (6::Integer)- , wcLoggingAction = defaultLogger- }+defaultConf :: WatchdogState String+defaultConf = blankConf { wcLoggingAction = defaultLogger } +blankConf :: WatchdogState e+blankConf = WatchdogState { wcInitialDelay = 1 * 10 ^ (6::Integer)+ , wcMaximumDelay = 300 * 10 ^ (6::Integer)+ , wcMaximumRetries = 10+ , wcResetDuration = 30 * 10 ^ (6::Integer)+ , wcLoggingAction = silentLogger+ }+ -- | The Watchdog monad. Used to configure and eventually run a watchdog.-watchdog :: WatchdogAction a -> IO a-watchdog action = evalStateT (runWA action) defaultConf+watchdog :: WatchdogAction String a -> IO a+watchdog = watchdogWith defaultConf +-- | As with 'watchdog', but don't specify a default logging action to+-- allow it to be polymorphic.+watchdogBlank :: WatchdogAction e a -> IO a+watchdogBlank = watchdogWith blankConf++watchdogWith :: WatchdogState e -> WatchdogAction e a -> IO a+watchdogWith conf action = evalStateT (runWA action) conf+ -- | Set the initial delay in microseconds. The first time the watchdog pauses -- will be for this amount of time. The default is 1 second.-setInitialDelay :: Int -> WatchdogAction ()-setInitialDelay delay = do- conf <- get- put conf { wcInitialDelay = delay }+setInitialDelay :: Int -> WatchdogAction e ()+setInitialDelay delay = modify (\conf -> conf { wcInitialDelay = delay }) -- | Set the maximum delay in microseconds. When a task fails to execute -- properly multiple times in quick succession, the delay is doubled each time -- until it stays constant at the maximum delay. The default is 300 seconds.-setMaximumDelay :: Int -> WatchdogAction ()-setMaximumDelay delay = do- conf <- get- put conf { wcMaximumDelay = delay }+setMaximumDelay :: Int -> WatchdogAction e ()+setMaximumDelay delay = modify (\conf -> conf { wcMaximumDelay = delay }) -- | If a task has been running for some time, the watchdog will consider -- the next failure to be something unrelated and reset the waiting time -- back to the initial delay. This function sets the amount of time in -- microseconds that needs to pass before the watchdog will consider a task to -- be successfully running. The default is 30 seconds.-setResetDuration :: Int -> WatchdogAction ()-setResetDuration duration = do- conf <- get- put conf { wcResetDuration = duration }+setResetDuration :: Int -> WatchdogAction e ()+setResetDuration duration = modify (\conf -> conf { wcResetDuration = duration }) -- | Set the number of retries after which the watchdog will give up and -- return with a permanent error. This setting is only used in combination with -- 'watchImpatiently'. The default is 10.-setMaximumRetries :: Integer -> WatchdogAction ()-setMaximumRetries retries = do- conf <- get- put conf { wcMaximumRetries = retries }+setMaximumRetries :: Integer -> WatchdogAction e ()+setMaximumRetries retries = modify (\conf -> conf { wcMaximumRetries = retries }) -- | Set the logging action that will be called by the watchdog. The supplied -- function of type 'WatchdogLogger' will be provided with the error message of -- the task and either 'Nothing' if the watchdog will retry immediately or 'Just -- delay' if the watchdog will now pause for the specified amount of time before -- trying again. The default is 'defaultLogger'.-setLoggingAction :: WatchdogLogger -> WatchdogAction ()-setLoggingAction f = do- conf <- get- put conf { wcLoggingAction = f }+setLoggingAction :: WatchdogLogger e -> WatchdogAction e ()+setLoggingAction f = modify (\conf -> conf { wcLoggingAction = f }) -- | Watch a task, restarting it potentially forever or until it returns with a -- result. The task should return an 'Either', where 'Left' in combination with -- an error message signals an error and 'Right' with an arbitrary result -- signals success.-watch :: IO (Either String a) -> WatchdogAction a+watch :: IO (Either e a) -> WatchdogAction e a watch task = do conf <- get liftIO $ go conf (wcInitialDelay conf)@@ -209,41 +215,45 @@ -- | Watch a task, but only restart it a limited number of times (see -- 'setMaximumRetries'). If the failure persists, it will be returned as a 'Left', -- otherwise it will be 'Right' with the result of the task.-watchImpatiently :: IO (Either String b) -> WatchdogAction (Either String b)+watchImpatiently :: IO (Either e b) -> WatchdogAction e (Either e b) watchImpatiently task = do conf <- get- liftIO $ go conf 0 "" (wcInitialDelay conf)+ liftIO $ go conf 0 (wcInitialDelay conf) where- go conf retries lastError errorDelay = do+ go conf retries errorDelay = do status <- timeTask (wcResetDuration conf) task case status of CompletedSuccessfully result -> return $ Right result FailedAfterAWhile err -> if retries >= wcMaximumRetries conf- then return $ Left lastError+ then return $ Left err else do let errorDelay' = wcInitialDelay conf loggingAction = wcLoggingAction conf loggingAction err Nothing- go conf (retries + 1) err errorDelay'+ go conf (retries + 1) errorDelay' FailedImmediately err -> if retries >= wcMaximumRetries conf- then return $ Left lastError+ then return $ Left err else do let errorDelay' = min (errorDelay * 2) (wcMaximumDelay conf) loggingAction = wcLoggingAction conf loggingAction err (Just errorDelay) threadDelay errorDelay- go conf (retries + 1) err errorDelay'+ go conf (retries + 1) errorDelay' -- | The default logging action. It will call 'formatWatchdogError' and display -- the result on STDOUT.-defaultLogger :: WatchdogLogger+defaultLogger :: WatchdogLogger String defaultLogger taskErr delay = putStrLn $ formatWatchdogError taskErr delay +-- | As with 'defaultLogger', but calls 'show' on the value provided.+showLogger :: (Show e) => WatchdogLogger e+showLogger err = defaultLogger (show err)+ -- | Disable logging by passing this function to 'setLoggingAction'.-silentLogger :: WatchdogLogger+silentLogger :: WatchdogLogger e silentLogger _ _ = return () -- | Format the watchdog status report. Will produce output like this:@@ -252,16 +262,17 @@ -- Watchdog: Error executing task (some error) - trying again immediately. -- Watchdog: Error executing task (some error) - waiting 1s before trying again. -- @-formatWatchdogError :: String -- ^ Error message returned by the task.- -> Maybe Int -- ^ Waiting time - if any - before trying again.- -> String+formatWatchdogError :: (IsString str, Monoid str)+ => str -- ^ Error message returned by the task.+ -> Maybe Int -- ^ Waiting time - if any - before trying again.+ -> str formatWatchdogError taskErr Nothing =- "Watchdog: Error executing task (" ++ taskErr ++ ") - trying again immediately."+ "Watchdog: Error executing task (" <> taskErr <> ") - trying again immediately." formatWatchdogError taskErr (Just delay) = let asNominalDiffTime :: NominalDiffTime -- just to display it properly asNominalDiffTime = fromIntegral delay / 10 ^ (6 :: Integer)- in "Watchdog: Error executing task (" ++ taskErr ++ ") - waiting"- ++ " " ++ show asNominalDiffTime ++ " before trying again."+ in "Watchdog: Error executing task (" <> taskErr <> ") - waiting"+ <> " " <> fromString (show asNominalDiffTime) <> " before trying again." -- | Helper class which can be wrapped around a task. -- The task should return an 'Either', where Left in combination@@ -269,7 +280,7 @@ -- result signals success. In case of failure, the wrapper will check whether -- the function ran less than 30 seconds and then return 'FailedImmediately' -- or 'FailedAfterAWhile' accordingly.-timeTask :: Int -> IO (Either String a) -> IO (WatchdogTaskStatus a)+timeTask :: Int -> IO (Either e a) -> IO (WatchdogTaskStatus e a) timeTask resetDuration task = do start <- getCurrentTime status <- task
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012 - 2014, Jan Vornberger+Copyright (c) 2012 - 2017, Jan Vornberger All rights reserved. Redistribution and use in source and binary forms, with or without
watchdog.cabal view
@@ -1,5 +1,5 @@ name: watchdog-version: 0.2.3+version: 0.3 author: Jan Vornberger <jan@uos.de> copyright: (c) 2012 - 2017 Jan Vornberger maintainer: Jan Vornberger <jan@uos.de>@@ -17,7 +17,7 @@ location: https://github.com/javgh/watchdog library- build-depends: base == 4.*+ build-depends: base >= 4.5 && < 5 , time >= 1.4 && < 1.9 , mtl >= 2.1 && < 2.3 exposed-modules: Control.Watchdog