content: {-# LANGUAGE RecordWildCards #-}
  
  module DNS.Utils.AutoUpdate (
      -- * interfaces
      mkAutoUpdate,
      mkClosableAutoUpdate,
  
      -- * dubugging
      mkClosableAutoUpdate',
      UpdateState,
  )
  where
  
  -- GHC packages
  
  import Control.Concurrent.STM
  import Control.Monad
  import Data.IORef
  import GHC.Event (getSystemTimerManager, registerTimeout, unregisterTimeout)
  
  mkAutoUpdate :: Int -> IO a -> IO (IO a)
  mkAutoUpdate micro uaction = fst <$> mkClosableAutoUpdate micro uaction
  
  -- $setup
  -- >>> :set -XNumericUnderscores
  -- >>> import Control.Concurrent
  
  -- |
  -- >>> iref <- newIORef (0 :: Int)
  -- >>> action = modifyIORef iref (+ 1) >> readIORef iref
  -- >>> (getValue, closeState) <- mkClosableAutoUpdate 200_000 action
  -- >>> getValue
  -- 1
  -- >>> threadDelay 100_000 >> getValue
  -- 1
  -- >>> threadDelay 200_000 >> getValue
  -- 2
  -- >>> closeState
  mkClosableAutoUpdate :: Int -> IO a -> IO (IO a, IO ())
  mkClosableAutoUpdate = mkAutoUpdateThings $ \g c _ -> (g, c)
  
  -- | provide `UpdateState` for debugging
  mkClosableAutoUpdate' :: Int -> IO a -> IO (IO a, IO (), UpdateState a)
  mkClosableAutoUpdate' = mkAutoUpdateThings (,,)
  
  mkAutoUpdateThings :: (IO a -> IO () -> UpdateState a -> b) -> Int -> IO a -> IO b
  mkAutoUpdateThings mk micro uaction = do
      us <- openUpdateState micro uaction
      pure $ mk (getUpdateResult us) (closeUpdateState us) us
  
  --------------------------------------------------------------------------------
  
  {- FOURMOLU_DISABLE -}
  data UpdateState a =
      UpdateState
      { usUpdateAction_   :: IO a
      , usLastResult_     :: IORef a
      , usIntervalMicro_  :: Int
      , usTimeHasCome_    :: TVar Bool
      , usDeleteTimeout_  :: IORef (IO ())
      }
  {- FOURMOLU_ENABLE -}
  
  mkDeleteTimeout :: TVar Bool -> Int -> IO (IO ())
  mkDeleteTimeout thc micro = do
      mgr <- getSystemTimerManager
      key <- registerTimeout mgr micro (atomically $ writeTVar thc True)
      pure $ unregisterTimeout mgr key
  
  openUpdateState :: Int -> IO a -> IO (UpdateState a)
  openUpdateState micro uaction = do
      thc <- newTVarIO False
      UpdateState uaction <$> (newIORef =<< uaction) <*> pure micro <*> pure thc <*> (newIORef =<< mkDeleteTimeout thc micro)
  
  closeUpdateState :: UpdateState a -> IO ()
  closeUpdateState UpdateState{..} = do
      delete <- readIORef usDeleteTimeout_
      delete
  
  onceOnTimeHasCome :: UpdateState a -> IO () -> IO ()
  onceOnTimeHasCome UpdateState{..} action = do
      action' <- atomically $ do
          timeHasCome <- readTVar usTimeHasCome_
          when timeHasCome $ writeTVar usTimeHasCome_ False
          pure $ when timeHasCome action
      action'
  
  getUpdateResult :: UpdateState a -> IO a
  getUpdateResult us@UpdateState{..} = do
      onceOnTimeHasCome us $ do
          writeIORef usLastResult_ =<< usUpdateAction_
          writeIORef usDeleteTimeout_ =<< mkDeleteTimeout usTimeHasCome_ usIntervalMicro_
      readIORef usLastResult_
  