{-# LANGUAGE OverloadedStrings #-}
module Debounce (
  Debounce,
  makeDebounce, debounceClick,
) where

import Control.Concurrent
import Control.Monad (when, void)
import Data.IORef
import Data.Text (Text)
-- import Data.Text qualified as T

-- import AtomicPrint


-- delay in microseconds; current waiter
data Debounce = Debounce Text Int (IO ()) (IORef State)

data State = Idle  -- ^ no event recently
           | Waiting  -- ^ recent event, debouncing
           | Running  -- ^ delay expired, running action
           | RunningRerun  -- ^ still running action but another event appeared in the mean time
  deriving (Show)

-- State transition diagram:
--
--      ,---------> IDLE
--     |              |
--     |        click |,-----. click
--     |              V      |
--     |           WAITING >-'
--     |              | ^.______________
--     |  threadDelay |                 \ (completed)
--     |              V                  |
--     '---------< RUNNING -------> RUNNINGRERUN >-,
--   (completed)            click            ^.___/ click
--
-- In Idle, no debounceWait thread is running.
-- In Waiting, debounceWait is in its threadDelay.
-- In Running & RunningRerun, debounceWait is in its 'action'.
-- There is always <=1 debounceWait thread at a time.

makeDebounce :: Text -> Double -> IO () -> IO Debounce
makeDebounce description secs action = Debounce description (round (secs * 1e6)) action <$> newIORef Idle

debounceClick :: Debounce -> IO ()
debounceClick deb@(Debounce _descr _ _ ref) = do
  (gowait, _origstate) <- atomicModifyIORef' ref $ \st -> case st of
    Idle -> (Waiting, (True, st))
    Waiting -> (Waiting, (False, st))
    Running -> (RunningRerun, (False, st))
    RunningRerun -> (RunningRerun, (False, st))

  -- atomicPrint $ "debounce[" <> _descr <> "] @ " <> T.show _origstate

  when gowait $
    debounceWait deb

-- Precondition: current state is Waiting
debounceWait :: Debounce -> IO ()
debounceWait deb@(Debounce _descr delay action ref) =
  void . forkIO $ do
    threadDelay delay
    atomicModifyIORef' ref $ \case
      Waiting -> (Running, ())
      st -> error $ "debounce: unexpected " ++ show st ++ ", should be Waiting"
    -- atomicPrint $ "debounce[" <> _descr <> "] running"
    action
    gowait <- atomicModifyIORef' ref $ \case
      Running -> (Idle, False)
      RunningRerun -> (Waiting, True)
      st -> error $ "debounce: unexpected " ++ show st ++ ", should be Running(Rerun)"
    -- atomicPrint $ "debounce[" <> _descr <> "] done, " <> (if gowait then "again" else "now idle")
    when gowait $
      debounceWait deb