0 | ||| This module provides functions for running computations
 1 | ||| once or more at discrete time intervals.
 2 | |||
 3 | ||| This provides a layer of abstraction and security on top
 4 | ||| of module `System.UV.Timer.Raw`.
 5 | module System.UV.Timer
 6 |
 7 | import IO.Async.Event
 8 | import System.UV.Loop
 9 | import System.UV.Pointer
10 | import System.UV.Raw.Handle
11 | import System.UV.Raw.Timer
12 |
13 | %default total
14 |
15 | %inline stopTimer : HasIO io => Ptr Timer -> io ()
16 | stopTimer = ignore . uv_timer_stop
17 |
18 | parameters {auto cc : CloseCB}
19 |   export %inline
20 |   Resource (Ptr Timer) where
21 |     release h = stopTimer h >> uv_close h cc
22 |
23 | parameters {auto l   : UVLoop}
24 |            {auto has : Has UVError es}
25 |   export
26 |   mkTimer : Async es (Ptr Timer)
27 |   mkTimer = mallocPtr Timer >>= uvAct (uv_timer_init l.loop)
28 |
29 |   ||| Sends a signal every `repeat` milliseconds, the first time
30 |   ||| after `timeout` has passed.
31 |   export
32 |   repeatedly :
33 |        (timeout,repeat : Bits64)
34 |     -> (Event Nat -> Async es a)
35 |     -> Async es a
36 |   repeatedly t r run =
37 |     use1 mkTimer $ \pt => do
38 |       ev <- newEvent
39 |       uv $ uv_timer_start pt (\_ => send ev 1 id (+)) t r
40 |       run ev
41 |
42 |   ||| Sends a signal after `timeout` milliseconds have passed.
43 |   export
44 |   sleep : (timeout : Bits64) -> Async es ()
45 |   sleep t = do
46 |     uvCancelableAsync
47 |       mkTimer stopTimer release (\p,cb => uv_timer_start p (\_ => cb ()) t 0)
48 |