From c48f9422641bdae715b9fb5e0b1484be73176d28 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Tue, 28 May 2019 17:01:18 -0700 Subject: [PATCH] add effectful timers --- app/baby.hoon | 16 ++++++++++-- lib/stdio.hoon | 10 +++++++- lib/tapp.hoon | 69 +++++++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 86 insertions(+), 9 deletions(-) diff --git a/app/baby.hoon b/app/baby.hoon index a6d99c5a1b..02111e375a 100644 --- a/app/baby.hoon +++ b/app/baby.hoon @@ -50,8 +50,8 @@ :: :: The app :: -%- create-tapp-poke-peer:tapp -^- tapp-core-poke-peer:tapp +%- create-tapp-poke-peer-take:tapp +^- tapp-core-poke-peer-take:tapp |_ [=bowl:gall state] :: :: Main function @@ -70,6 +70,9 @@ ~& 'Top comments:' %- (slog (zing (turn top-comments comment-to-tang))) (pure:m top-comments) + ?: =(cord.command 'poll') + ;< ~ bind:m (wait-effect (add now.bowl ~s15)) + (pure:m top-comments) :: :: Otherwise, fetch the top HN stories :: @@ -130,4 +133,13 @@ ^- form:m ~& [%baby-take-peer path] (pure:m top-comments) +:: +++ handle-take + |= sign:tapp + =/ m tapp-trad + ^- form:m + ;< =state bind:m (handle-command %noun 'fetch') + =. top-comments state + (pure:m top-comments) + :: (handle-command %noun 'poll') -- diff --git a/lib/stdio.hoon b/lib/stdio.hoon index ea30c1192f..459dd2912e 100644 --- a/lib/stdio.hoon +++ b/lib/stdio.hoon @@ -147,7 +147,7 @@ |= at=@da =/ m (trad ,~) ^- form:m - ;< ~ bind:m (send-raw-card %wait /(scot %da at) at) + ;< ~ bind:m (send-raw-card %wait /note/(scot %da at) at) (set-raw-contract & %wait at) :: :: Wait until we get a wake event @@ -185,6 +185,14 @@ ;< ~ bind:m (send-wait until) take-wake :: +:: Wait until time then start new computation +:: +++ wait-effect + |= until=@da + =/ m (trad ,~) + ^- form:m + (send-effect %wait /effect/(scot %da until) until) +:: :: Cancel computation if not done by time :: ++ set-timeout diff --git a/lib/tapp.hoon b/lib/tapp.hoon index 43a60b4d1f..553e490c88 100644 --- a/lib/tapp.hoon +++ b/lib/tapp.hoon @@ -15,6 +15,7 @@ $% [%poke command=command-type] [%peer =path] [%diff =dock =path =in-peer-data] + [%take =sign] == :: ++ trad-lib (^trad sign card contract) @@ -67,6 +68,7 @@ ++ handle-command ~(handle-command handler bowl state) ++ handle-peer ~(handle-peer handler bowl state) ++ handle-diff |=(* (trad-fail:trad-lib %no-diff-handler >path< ~)) + ++ handle-take |=(* (trad-fail:trad-lib %no-take-handler >path< ~)) -- :: :: The form of a tapp that only handles pokes and diffs @@ -88,13 +90,14 @@ %- create-tapp-all |_ [=bowl:gall state=state-type] ++ handle-command ~(handle-command handler bowl state) - ++ handle-peer |=(=path (trad-fail:trad-lib %no-peer-handler >path< ~)) + ++ handle-peer |=(* (trad-fail:trad-lib %no-peer-handler >path< ~)) ++ handle-diff ~(handle-diff handler bowl state) + ++ handle-take |=(* (trad-fail:trad-lib %no-take-handler >path< ~)) -- :: -:: The form of a tapp +:: The form of a tapp that only handles pokes, peers, and takes :: -++ tapp-core-all +++ tapp-core-poke-peer-take $_ ^| |_ [bowl:gall state-type] ++ handle-command @@ -105,9 +108,50 @@ |~ path *form:tapp-trad :: + ++ handle-take + |~ sign + *form:tapp-trad + -- +:: +++ create-tapp-poke-peer-take + |= handler=tapp-core-poke-peer-take + %- create-tapp-all + |_ [=bowl:gall state=state-type] + ++ handle-command ~(handle-command handler bowl state) + ++ handle-peer ~(handle-peer handler bowl state) + ++ handle-diff |=(* (trad-fail:trad-lib %no-diff-handler >path< ~)) + ++ handle-take ~(handle-take handler bowl state) + -- +:: +:: The form of a tapp +:: +++ tapp-core-all + $_ ^| + |_ [bowl:gall state-type] + :: + :: Input + :: + ++ handle-command + |~ command-type + *form:tapp-trad + :: + :: Subscription request + :: + ++ handle-peer + |~ path + *form:tapp-trad + :: + :: Receive subscription result + :: ++ handle-diff |~ [dock path in-peer-data] *form:tapp-trad + :: + :: Receive syscall result + :: + ++ handle-take + |~ sign + *form:tapp-trad -- :: ++ create-tapp-all @@ -172,13 +216,21 @@ ^- (quip move _this-tapp) (oob-fail-trad %failed-sigh tang) :: - ++ wake + ++ wake-note |= [=wire error=(unit tang)] ^- (quip move _this-tapp) ?^ error (oob-fail-trad %timer-fire-failed u.error) (take-trad bowl `[wire %wake ~]) :: + ++ wake-effect + |= [=wire error=(unit tang)] + ^- (quip move _this-tapp) + =. waiting (~(put to waiting) %take %wake error) + ?^ active + `this-tapp + start-trad + :: :: Continue computing trad :: ++ take-trad @@ -191,7 +243,11 @@ :: ?: ?=([~ @ %sigh *] in.trad-input) `this-tapp - ~| %no-active-trad !! + ~| %no-active-trad + ~| ?~ in.trad-input + ~ + wire.u.in.trad-input + !! =^ r=[moves=(list move) =eval-result:eval:m] u.active (take:eval:m u.active ost.bowl trad-input) => .(active `(unit eval-form:eval:tapp-trad)`active) :: TMI @@ -258,6 +314,7 @@ %poke (~(handle-command handler bowl app-state) command.u.next) %peer (~(handle-peer handler bowl app-state) path.u.next) %diff (~(handle-diff handler bowl app-state) +.u.next) + %take (~(handle-take handler bowl app-state) +.u.next) == (take-trad bowl ~) :: @@ -274,7 +331,7 @@ |= =contract ^- (list move) ?- -.contract - %wait [ost.bowl %rest /(scot %da at.contract) at.contract]~ + %wait [ost.bowl %rest /note/(scot %da at.contract) at.contract]~ %hiss ~ :: can't cancel; will ignore response == --