never executed always true always false

    1 module PureClaw.Scheduler.Heartbeat
    2   ( -- * Heartbeat configuration
    3     HeartbeatConfig (..)
    4   , defaultHeartbeatConfig
    5     -- * Heartbeat runner
    6   , HeartbeatState (..)
    7   , mkHeartbeatState
    8   , runHeartbeat
    9   , stopHeartbeat
   10   , isHeartbeatRunning
   11     -- * Single tick (for testing)
   12   , heartbeatTick
   13   ) where
   14 
   15 import Control.Concurrent
   16 import Control.Concurrent.STM
   17 import Control.Exception
   18 import Data.Text (Text)
   19 import Data.Text qualified as T
   20 import Data.Time
   21 
   22 import PureClaw.Handles.Log
   23 
   24 -- | Configuration for the heartbeat scheduler.
   25 data HeartbeatConfig = HeartbeatConfig
   26   { _hb_intervalSeconds :: Int
   27   , _hb_name            :: Text
   28   }
   29   deriving stock (Show, Eq)
   30 
   31 -- | Default heartbeat: every 60 seconds.
   32 defaultHeartbeatConfig :: HeartbeatConfig
   33 defaultHeartbeatConfig = HeartbeatConfig
   34   { _hb_intervalSeconds = 60
   35   , _hb_name            = "heartbeat"
   36   }
   37 
   38 -- | Mutable heartbeat state.
   39 data HeartbeatState = HeartbeatState
   40   { _hbs_config    :: HeartbeatConfig
   41   , _hbs_running   :: TVar Bool
   42   , _hbs_lastTick  :: TVar (Maybe UTCTime)
   43   , _hbs_tickCount :: TVar Int
   44   }
   45 
   46 -- | Create a fresh heartbeat state.
   47 mkHeartbeatState :: HeartbeatConfig -> IO HeartbeatState
   48 mkHeartbeatState config = HeartbeatState config
   49   <$> newTVarIO False
   50   <*> newTVarIO Nothing
   51   <*> newTVarIO 0
   52 
   53 -- | Run the heartbeat loop in a new thread. The provided action is
   54 -- called on each tick. Returns the thread ID. Use 'stopHeartbeat' to
   55 -- stop the loop.
   56 runHeartbeat :: HeartbeatState -> LogHandle -> IO () -> IO ThreadId
   57 runHeartbeat hbs lh action = do
   58   atomically $ writeTVar (_hbs_running hbs) True
   59   _lh_logInfo lh $ "Heartbeat started: " <> _hb_name (_hbs_config hbs)
   60   forkIO $ heartbeatLoop hbs lh action
   61 
   62 -- | Stop the heartbeat loop.
   63 stopHeartbeat :: HeartbeatState -> IO ()
   64 stopHeartbeat hbs = atomically $ writeTVar (_hbs_running hbs) False
   65 
   66 -- | Check if the heartbeat is running.
   67 isHeartbeatRunning :: HeartbeatState -> IO Bool
   68 isHeartbeatRunning hbs = readTVarIO (_hbs_running hbs)
   69 
   70 -- | Execute a single heartbeat tick. Updates last tick time and count.
   71 -- Returns 'True' if the action completed successfully.
   72 heartbeatTick :: HeartbeatState -> LogHandle -> IO () -> IO Bool
   73 heartbeatTick hbs lh action = do
   74   now <- getCurrentTime
   75   result <- try action
   76   case result of
   77     Left (e :: SomeException) -> do
   78       _lh_logError lh $ "Heartbeat tick failed: " <> T.pack (show e)
   79       pure False
   80     Right () -> do
   81       atomically $ do
   82         writeTVar (_hbs_lastTick hbs) (Just now)
   83         modifyTVar' (_hbs_tickCount hbs) (+ 1)
   84       pure True
   85 
   86 -- Internal: the heartbeat loop.
   87 heartbeatLoop :: HeartbeatState -> LogHandle -> IO () -> IO ()
   88 heartbeatLoop hbs lh action = do
   89   running <- readTVarIO (_hbs_running hbs)
   90   if running
   91     then do
   92       _ <- heartbeatTick hbs lh action
   93       threadDelay (intervalMicros hbs)
   94       heartbeatLoop hbs lh action
   95     else
   96       _lh_logInfo lh $ "Heartbeat stopped: " <> _hb_name (_hbs_config hbs)
   97 
   98 -- Internal: convert interval seconds to microseconds.
   99 intervalMicros :: HeartbeatState -> Int
  100 intervalMicros hbs = _hb_intervalSeconds (_hbs_config hbs) * 1000000