{-| Behn: Timer Driver -} module Urbit.Vere.Behn (behn) where import Urbit.Arvo hiding (Behn) import Urbit.Prelude import Urbit.Vere.Pier.Types import Urbit.King.App (HasKingId(..)) 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 :: HasKingId e => e -> QueueEv -> ([Ev], Acquire (EffCb e BehnEf)) behn env enqueueEv = (initialEvents, runBehn) where king = fromIntegral (env ^. kingIdL) 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)