Struggling to implement a timer

user_14722688 0
Viewed 116

I would like to implement a simple timer that I can

  1. exit at any time and get result
  2. run any number of times.

I come up with timer1 implementation. It satisfies (2) and almost satisfies (1) since it has to wait until threadDelay finishes. Any pointer would be appreciated.

ps. The another implementation with catch exception handling I have tried exits immediately but cannot exit via SIGINT twice or else the program will be terminated.

timer1 :: MVar () -> Int -> IO Int
timer1 v sec = do
  putStrLn (show sec)
  threadDelay 1000000
  tryTakeMVar v >>= \case
    Just _ -> return sec
    Nothing -> exitCond
  where
    exitCond = if sec > 0 then timer1 v (sec - 1) else return 0

main :: IO ()
main = do
  v <- newEmptyMVar
  installHandler sigINT (CatchOnce $ putMVar v ()) Nothing
  res <- timer1 v 5
  putStrLn $ "timer1: " ++ show res

  v <- newEmptyMVar
  installHandler sigINT (CatchOnce $ putMVar v ()) Nothing
  res <- timer1 v 5
  putStrLn $ "timer1: " ++ show res
haskell
2 Answers

I recommend spawning a thread that waits the right amount of time and then fills the MVar:

import Data.Time.Clock

timer1 :: MVar () -> Int -> IO Int
timer1 m sec = do
    before <- getCurrentTime
    forkIO (threadDelay (sec*1000000) >> putMVar m ())
    takeMVar m
    after <- getCurrentTime
    return (sec - floor (diffUTCTime after before))

Whichever of the forked threadDelay or the signal handler that fires first will wake up timer1's takeMVar.

Your main can remain unchanged.

user_7916040

Here's something I put together quickly:

{-# LANGUAGE LambdaCase #-}

import Control.Concurrent
import System.Posix
import Data.IORef

timer1 :: MVar () -> IORef Int -> Int -> IO ()
timer1 v t sec = do
  writeIORef t sec
  putStrLn (show sec)
  threadDelay 1000000
  if sec > 0
     then timer1 v t (sec - 1)
     else putMVar v ()

main :: IO ()
main = do
  v <- newEmptyMVar
  t <- newIORef 5
  installHandler sigINT (CatchOnce $ putMVar v ()) Nothing
  tid <- forkIO $ timer1 v t 5
  takeMVar v         -- wait for timer or user interrupt
  killThread tid     -- stop the timer
  res <- readIORef t -- read the current time
  putStrLn $ "timer1: " ++ show res
  
  v <- newEmptyMVar
  t <- newIORef 5
  installHandler sigINT (CatchOnce $ putMVar v ()) Nothing
  tid <- forkIO $ timer1 v t 5
  takeMVar v
  killThread tid
  res <- readIORef t
  putStrLn $ "timer1: " ++ show res

The main idea is to use the MVar both for the signal and for the timer end. Then you can run the timer in a separate thread and wait for the MVar to be filled in the main thread. That means you do need to keep track of the current time in some other way, I chose to use an IORef for that.

user_152075680
Related