mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-16 19:22:22 +03:00
46 lines
1.3 KiB
Haskell
46 lines
1.3 KiB
Haskell
module Urbit.Timer ( Timer(..), init, stop, start
|
|
, Sys.getSystemTime, sysTimeGapMicroSecs
|
|
) where
|
|
|
|
import Data.IORef
|
|
import Prelude hiding (init)
|
|
|
|
import qualified Data.Time.Clock.System as Sys
|
|
import qualified GHC.Event as Ev
|
|
|
|
|
|
-- Timer Stuff -----------------------------------------------------------------
|
|
|
|
data Timer = Timer
|
|
{ bState :: IORef (Maybe Ev.TimeoutKey)
|
|
, bManager :: Ev.TimerManager
|
|
}
|
|
|
|
init :: IO Timer
|
|
init = do
|
|
st <- newIORef Nothing
|
|
man <- Ev.getSystemTimerManager
|
|
pure (Timer st man)
|
|
|
|
sysTimeGapMicroSecs :: Sys.SystemTime -> Sys.SystemTime -> Int
|
|
sysTimeGapMicroSecs (Sys.MkSystemTime xSec xNs) (Sys.MkSystemTime ySec yNs) =
|
|
(+) (1_000_000 * fromIntegral (ySec - xSec))
|
|
((fromIntegral yNs - fromIntegral xNs) `quot` 1000)
|
|
|
|
start :: Timer -> Sys.SystemTime -> IO () -> IO ()
|
|
start timer@(Timer vSt man) time cb = do
|
|
let fire = cb >> stop timer
|
|
stop timer
|
|
now <- Sys.getSystemTime
|
|
let sleep = sysTimeGapMicroSecs now time
|
|
-- print (now, time, "->", sleep)
|
|
if (sleep <= 0) then fire else do
|
|
key <- Ev.registerTimeout man sleep fire
|
|
atomicWriteIORef vSt $! Just key
|
|
|
|
stop :: Timer -> IO ()
|
|
stop (Timer vSt man) =
|
|
atomicModifyIORef' vSt (Nothing,) >>= \case
|
|
Just key -> Ev.unregisterTimeout man key
|
|
Nothing -> pure ()
|