mirror of
https://github.com/urbit/shrub.git
synced 2024-12-21 09:51:36 +03:00
45 lines
1.1 KiB
Haskell
45 lines
1.1 KiB
Haskell
module Vere.Behn (behn) where
|
|
|
|
import UrbitPrelude
|
|
import Arvo hiding (Behn)
|
|
import Vere.Pier.Types
|
|
|
|
import Urbit.Time (Wen)
|
|
import Urbit.Timer (Timer)
|
|
|
|
import qualified Urbit.Time as Time
|
|
import qualified Urbit.Timer as Timer
|
|
|
|
|
|
-- Behn Stuff ------------------------------------------------------------------
|
|
|
|
bornEv :: KingId -> Ev
|
|
bornEv king = EvBlip $ BlipEvBehn $ BehnEvBorn (king, ()) ()
|
|
|
|
wakeEv :: Ev
|
|
wakeEv = EvBlip $ BlipEvBehn $ BehnEvWake () ()
|
|
|
|
sysTime = view Time.systemTime
|
|
|
|
behn :: KingId -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf))
|
|
behn king enqueueEv =
|
|
(initialEvents, runBehn)
|
|
where
|
|
initialEvents = [bornEv king]
|
|
|
|
runBehn :: Acquire (EffCb e BehnEf)
|
|
runBehn = do
|
|
tim <- mkAcquire Timer.init Timer.stop
|
|
pure (handleEf tim)
|
|
|
|
handleEf :: Timer -> BehnEf -> RIO e ()
|
|
handleEf b = io . \case
|
|
BehnEfVoid v -> absurd v
|
|
BehnEfDoze (i, ()) mWen -> do
|
|
when (i == king) (doze b mWen)
|
|
|
|
doze :: Timer -> Maybe Wen -> IO ()
|
|
doze tim = \case
|
|
Nothing -> Timer.stop tim
|
|
Just t -> Timer.start tim (sysTime t) $ atomically (enqueueEv wakeEv)
|