ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-21 23:47:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

trad -> async

Browse Source
This commit is contained in:
Philip Monk 2019-05-31 14:44:47 -07:00
parent 72eac492c8
commit a80d636886
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
5 changed files with 152 additions and 152 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
app/example-tapp-fetch.hoon
View File

@ -42,8 +42,8 @@
item=|=(item=@ud `tape`:(welp base "item/" +>:(scow %ui item) ".json"))
==
--
=, trad=trad:tapp
=, tapp-trad=tapp-trad:tapp
=, async=async:tapp
=, tapp-async=tapp-async:tapp
=, stdio
::
:: The app
@ -56,7 +56,7 @@
::
++ handle-poke
|= =in-poke-data
=/ m tapp-trad
=/ m tapp-async
^- form:m
::
:: If requested to print, just print what we have in our state
@ -127,14 +127,14 @@
::
++ handle-peer
|= =path
=/ m tapp-trad
=/ m tapp-async
^- form:m
~& [%tapp-fetch-take-peer path]
(pure:m top-comments)
::
++ handle-take
|= sign:tapp
=/ m tapp-trad
=/ m tapp-async
^- form:m
;< =state bind:m (handle-poke %noun 'fetch')
=. top-comments state

10
app/example-tapp-subscribe.hoon
View File

@ -17,19 +17,19 @@
++ tapp (^tapp state in-poke-data out-poke-data in-peer-data out-peer-data)
++ stdio (^stdio out-poke-data out-peer-data)
--
=, trad=trad:tapp
=, tapp-trad=tapp-trad:tapp
=, async=async:tapp
=, tapp-async=tapp-async:tapp
=, stdio
%- create-tapp-poke-diff:tapp
^- tapp-core-poke-diff:tapp
|_ [=bowl:gall state]
++ handle-poke
|= =in-poke-data
=/ m tapp-trad
=/ m tapp-async
^- form:m
?: =(cord.in-poke-data 'pull')
?~ subscription
(trad-fail %no-subscription ~)
(async-fail %no-subscription ~)
;< ~ bind:m (pull-app [target path]:u.subscription)
(pure:m ~)
=/ target [our.bowl %example-tapp-fetch]
@ -41,7 +41,7 @@
::
++ handle-diff
|= [[her=ship app=term] =path data=in-peer-data]
=/ m tapp-trad
=/ m tapp-async
^- form:m
?> ?=(%comments -.data)
~& subscriber-got-data=(lent comments.data)

54
lib/trad.hoon → lib/async.hoon
View File

@ -1,7 +1,7 @@
|* [input-type=mold card-type=mold contract-type=mold]
|%
+$ trad-input [=bowl:gall in=(unit [=wire sign=input-type])]
+$ trad-move (pair bone card-type)
+$ async-input [=bowl:gall in=(unit [=wire sign=input-type])]
+$ async-move (pair bone card-type)
::
:: cards: cards to send immediately. These will go out even if a
:: later stage of the computation fails, so they shouldn't have
@ -17,29 +17,29 @@
:: fail: abort computation; don't send effects
:: done: finish computation; send effects
::
++ trad-output-raw
++ async-output-raw
|* a=mold
$~ [~ ~ ~ %done *a]
$: cards=(list card-type)
effects=(list trad-move)
effects=(list async-move)
contracts=(set [add=? contract=contract-type])
$= next
$% [%wait ~]
[%cont self=(trad-form-raw a)]
[%cont self=(async-form-raw a)]
[%fail err=(pair term tang)]
[%done value=a]
==
==
::
++ trad-form-raw
++ async-form-raw
|* a=mold
$-(trad-input (trad-output-raw a))
$-(async-input (async-output-raw a))
::
:: Abort asynchronous computation with error message
::
++ trad-fail
++ async-fail
|= err=(pair term tang)
|= trad-input
|= async-input
[~ ~ ~ %fail err]
::
:: Asynchronous transcaction monad.
@ -50,31 +50,31 @@
:: - Continuation
:: - Exception
::
++ trad
++ async
|* a=mold
|%
++ output (trad-output-raw a)
++ output (async-output-raw a)
::
:: Type of an asynchronous computation.
::
++ form (trad-form-raw a)
++ form (async-form-raw a)
::
:: Monadic pure. Identity computation for bind.
::
++ pure
|= arg=a
^- form
|= trad-input
|= async-input
[~ ~ ~ %done arg]
::
:: Monadic bind. Combines two computations, associatively.
::
++ bind
|* b=mold
|= [m-b=(trad-form-raw b) fun=$-(b form)]
|= [m-b=(async-form-raw b) fun=$-(b form)]
^- form
|= input=trad-input
=/ b-res=(trad-output-raw b)
|= input=async-input
=/ b-res=(async-output-raw b)
(m-b input)
^- output
:^ cards.b-res effects.b-res contracts.b-res
@ -85,15 +85,15 @@
%done [%cont (fun value.next.b-res)]
==
::
:: The trad monad must be evaluted in a particular way to maintain
:: The async monad must be evaluted in a particular way to maintain
:: its monadic character. +take:eval implements this.
::
++ eval
|%
:: Indelible state of a trad
:: Indelible state of a async
::
+$ eval-form
$: effects=(list trad-move)
$: effects=(list async-move)
contracts=(set contract-type)
=form
==
@ -113,18 +113,18 @@
[%done contracts=(set contract-type) value=a]
==
::
:: Take a new sign and run the trad against it
:: Take a new sign and run the async against it
::
++ take
:: moves: accumulate throughout recursion the moves to be
:: produced now
=| moves=(list trad-move)
|= [=eval-form =bone =trad-input]
^- [[(list trad-move) =eval-result] _eval-form]
=| moves=(list async-move)
|= [=eval-form =bone =async-input]
^- [[(list async-move) =eval-result] _eval-form]
=* take-loop $
:: run the trad callback
:: run the async callback
::
=/ =output (form.eval-form trad-input)
=/ =output (form.eval-form async-input)
:: add cards to moves
::
=. moves
@ -132,7 +132,7 @@
moves
%+ turn cards.output
|= card=card-type
^- trad-move
^- async-move
[bone card]
:: add effects to list to be produced when done
::
@ -182,7 +182,7 @@
::
%_ take-loop
form.eval-form self.next.output
trad-input [bowl.trad-input ~]
async-input [bowl.async-input ~]
==
==
--

106
lib/stdio.hoon
View File

@ -1,7 +1,7 @@
:: Standard input/output functions.
::
:: These are all asynchronous computations, which means they produce a
:: form:(trad A) for some type A. You can always tell what they
:: form:(async A) for some type A. You can always tell what they
:: produce by checking their first three lines.
::
:: Functions with the word "raw" in their name are for internal use
@ -11,51 +11,51 @@
:: fails.
::
/- tapp-sur=tapp
/+ trad
/+ async
|* [poke-data=mold out-peer-data=mold]
=/ tapp-sur (tapp-sur poke-data out-peer-data)
=, card=card:tapp-sur
=, sign=sign:tapp-sur
=, contract=contract:tapp-sur
=+ (trad sign card contract)
=+ (async sign card contract)
|%
::
:: Raw power
::
++ send-raw-card
|= =card
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
|= =trad-input
|= =async-input
[[card]~ ~ ~ %done ~]
::
:: Add or remove a contract
::
++ set-raw-contract
|= [add=? =contract]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
|= trad-input
|= async-input
[~ ~ (silt [add contract]~) %done ~]
::
:: Send effect on current bone
::
++ send-effect
|= =card
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< =bone bind:m
|= =trad-input
[~ ~ ~ %done ost.bowl.trad-input]
|= =async-input
[~ ~ ~ %done ost.bowl.async-input]
(send-effect-on-bone bone card)
::
:: Send effect on particular bone
::
++ send-effect-on-bone
|= [=bone =card]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
|= trad-input
|= async-input
[~ [bone card]~ ~ %done ~]
::
:: ----
@ -64,7 +64,7 @@
::
++ send-hiss
|= =hiss:eyre
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< ~ bind:m (send-raw-card %hiss / ~ %httr %hiss hiss)
(set-raw-contract & %hiss ~)
@ -72,20 +72,20 @@
:: Wait until we get an HTTP response
::
++ take-sigh-raw
=/ m (trad ,httr:eyre)
=/ m (async ,httr:eyre)
^- form:m
|= =trad-input
|= =async-input
:^ ~ ~ ~
?~ in.trad-input
?~ in.async-input
[%wait ~]
?. ?=(%sigh -.sign.u.in.trad-input)
[%fail %expected-sigh >got=-.sign.u.in.trad-input< ~]
[%done httr.sign.u.in.trad-input]
?. ?=(%sigh -.sign.u.in.async-input)
[%fail %expected-sigh >got=-.sign.u.in.async-input< ~]
[%done httr.sign.u.in.async-input]
::
:: Wait until we get an HTTP response and unset contract
::
++ take-sigh
=/ m (trad ,httr:eyre)
=/ m (async ,httr:eyre)
^- form:m
;< =httr:eyre bind:m take-sigh-raw
;< ~ bind:m (set-raw-contract | %hiss ~)
@ -95,30 +95,30 @@
::
++ extract-httr-body
|= =httr:eyre
=/ m (trad ,cord)
=/ m (async ,cord)
^- form:m
?. =(2 (div p.httr 100))
(trad-fail %httr-error >p.httr< >+.httr< ~)
(async-fail %httr-error >p.httr< >+.httr< ~)
?~ r.httr
(trad-fail %expected-httr-body >httr< ~)
(async-fail %expected-httr-body >httr< ~)
(pure:m q.u.r.httr)
::
:: Parse cord to json
::
++ parse-json
|= =cord
=/ m (trad ,json)
=/ m (async ,json)
^- form:m
=/ json=(unit json) (de-json:html cord)
?~ json
(trad-fail %json-parse-error ~)
(async-fail %json-parse-error ~)
(pure:m u.json)
::
:: Fetch json at given url
::
++ fetch-json
|= url=tape
=/ m (trad ,json)
=/ m (async ,json)
^- form:m
=/ =hiss:eyre
:* purl=(scan url auri:de-purl:html)
@ -136,16 +136,16 @@
:: Time is what keeps everything from happening at once
::
++ get-time
=/ m (trad ,@da)
=/ m (async ,@da)
^- form:m
|= =trad-input
[~ ~ ~ %done now.bowl.trad-input]
|= =async-input
[~ ~ ~ %done now.bowl.async-input]
::
:: Set a timer
::
++ send-wait
|= at=@da
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< ~ bind:m (send-raw-card %wait /note/(scot %da at) at)
(set-raw-contract & %wait at)
@ -153,17 +153,17 @@
:: Wait until we get a wake event
::
++ take-wake-raw
=/ m (trad ,@da)
=/ m (async ,@da)
^- form:m
|= =trad-input
|= =async-input
:^ ~ ~ ~
?~ in.trad-input
?~ in.async-input
[%wait ~]
?. ?=(%wake -.sign.u.in.trad-input)
[%fail %expected-wake >got=-.sign.u.in.trad-input< ~]
?~ wire.u.in.trad-input
?. ?=(%wake -.sign.u.in.async-input)
[%fail %expected-wake >got=-.sign.u.in.async-input< ~]
?~ wire.u.in.async-input
[%fail %expected-wake-time ~]
=/ at=(unit @da) (slaw %da i.wire.u.in.trad-input)
=/ at=(unit @da) (slaw %da i.wire.u.in.async-input)
?~ at
[%fail %expected-wake-time-da >wire< ~]
[%done u.at]
@ -171,7 +171,7 @@
:: Wait until we get a wake event and unset contract
::
++ take-wake
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< at=@da bind:m take-wake-raw
(set-raw-contract | %wait at)
@ -180,7 +180,7 @@
::
++ wait
|= until=@da
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< ~ bind:m (send-wait until)
take-wake
@ -189,7 +189,7 @@
::
++ wait-effect
|= until=@da
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
(send-effect %wait /effect/(scot %da until) until)
::
@ -197,17 +197,17 @@
::
++ set-timeout
|* computation-result=mold
=/ m (trad ,computation-result)
=/ m (async ,computation-result)
|= [when=@da computation=form:m]
^- form:m
;< ~ bind:m (send-wait when)
|= =trad-input
|= =async-input
=* loop $
?: ?& ?=([~ * %wake *] in.trad-input)
=(/(scot %da when) wire.u.in.trad-input)
?: ?& ?=([~ * %wake *] in.async-input)
=(/(scot %da when) wire.u.in.async-input)
==
[~ ~ (silt [| %wait when]~) %fail %trad-timeout ~]
=/ c-res (computation trad-input)
[~ ~ (silt [| %wait when]~) %fail %async-timeout ~]
=/ c-res (computation async-input)
?. ?=(%cont -.next.c-res)
c-res
c-res(self.next ..loop(computation self.next.c-res))
@ -218,20 +218,20 @@
::
++ poke-app
|= [[her=ship app=term] =poke-data]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
(send-effect %poke / [her app] poke-data)
::
++ peer-app
|= [[her=ship app=term] =path]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
=/ =wire (weld /(scot %p her)/[app] path)
(send-effect %peer wire [her app] path)
::
++ pull-app
|= [[her=ship app=term] =path]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
=/ =wire (weld /(scot %p her)/[app] path)
(send-effect %pull wire [her app] ~)
@ -244,12 +244,12 @@
::
++ get-bones-on-path
|= =the=path
=/ m (trad ,(list bone))
=/ m (async ,(list bone))
^- form:m
|= =trad-input
|= =async-input
:^ ~ ~ ~
:- %done
%+ murn ~(tap by sup.bowl.trad-input)
%+ murn ~(tap by sup.bowl.async-input)
|= [ost=bone her=ship =sub=path]
^- (unit bone)
?. =(the-path sub-path)
@ -260,7 +260,7 @@
::
++ give-result
|= [=path =out-peer-data]
=/ m (trad ,~)
=/ m (async ,~)
^- form:m
;< bones=(list bone) bind:m (get-bones-on-path path)
|- ^- form:m

124
lib/tapp.hoon
View File

@ -1,5 +1,5 @@
/- tapp-sur=tapp
/+ trad
/+ async
|* $: state-type=mold
in-poke-data=mold
out-poke-data=mold
@ -18,14 +18,14 @@
[%take =sign]
==
::
++ trad-lib (^trad sign card contract)
++ trad trad:trad-lib
++ async-lib (^async sign card contract)
++ async async:async-lib
::
+$ move (pair bone card)
++ tapp-trad (trad state-type)
++ tapp-async (async state-type)
+$ tapp-state
$: waiting=(qeu command)
active=(unit eval-form:eval:tapp-trad)
active=(unit eval-form:eval:tapp-async)
app-state=state-type
==
::
@ -36,7 +36,7 @@
|_ [bowl:gall state-type]
++ handle-poke
|~ in-poke-data
*form:tapp-trad
*form:tapp-async
--
::
++ create-tapp-poke
@ -44,7 +44,7 @@
%- create-tapp-poke-peer
|_ [=bowl:gall state=state-type]
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer |=(* (trad-fail:trad-lib %no-peer-handler >path< ~))
++ handle-peer |=(* (async-fail:async-lib %no-peer-handler >path< ~))
--
::
:: The form of a tapp that only handles pokes and peers
@ -54,11 +54,11 @@
|_ [bowl:gall state-type]
++ handle-poke
|~ in-poke-data
*form:tapp-trad
*form:tapp-async
::
++ handle-peer
|~ path
*form:tapp-trad
*form:tapp-async
--
::
++ create-tapp-poke-peer
@ -67,8 +67,8 @@
|_ [=bowl:gall state=state-type]
++ handle-poke ~(handle-poke 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< ~))
++ handle-diff |=(* (async-fail:async-lib %no-diff-handler >path< ~))
++ handle-take |=(* (async-fail:async-lib %no-take-handler >path< ~))
--
::
:: The form of a tapp that only handles pokes and diffs
@ -78,11 +78,11 @@
|_ [bowl:gall state-type]
++ handle-poke
|~ in-poke-data
*form:tapp-trad
*form:tapp-async
::
++ handle-diff
|~ [dock path in-peer-data]
*form:tapp-trad
*form:tapp-async
--
::
++ create-tapp-poke-diff
@ -90,9 +90,9 @@
%- create-tapp-all
|_ [=bowl:gall state=state-type]
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer |=(* (trad-fail:trad-lib %no-peer-handler >path< ~))
++ handle-peer |=(* (async-fail:async-lib %no-peer-handler >path< ~))
++ handle-diff ~(handle-diff handler bowl state)
++ handle-take |=(* (trad-fail:trad-lib %no-take-handler >path< ~))
++ handle-take |=(* (async-fail:async-lib %no-take-handler >path< ~))
--
::
:: The form of a tapp that only handles pokes, peers, and takes
@ -102,15 +102,15 @@
|_ [bowl:gall state-type]
++ handle-poke
|~ in-poke-data
*form:tapp-trad
*form:tapp-async
::
++ handle-peer
|~ path
*form:tapp-trad
*form:tapp-async
::
++ handle-take
|~ sign
*form:tapp-trad
*form:tapp-async
--
::
++ create-tapp-poke-peer-take
@ -119,7 +119,7 @@
|_ [=bowl:gall state=state-type]
++ handle-poke ~(handle-poke handler bowl state)
++ handle-peer ~(handle-peer handler bowl state)
++ handle-diff |=(* (trad-fail:trad-lib %no-diff-handler >path< ~))
++ handle-diff |=(* (async-fail:async-lib %no-diff-handler >path< ~))
++ handle-take ~(handle-take handler bowl state)
--
::
@ -133,25 +133,25 @@
::
++ handle-poke
|~ in-poke-data
*form:tapp-trad
*form:tapp-async
::
:: Subscription request
::
++ handle-peer
|~ path
*form:tapp-trad
*form:tapp-async
::
:: Receive subscription result
::
++ handle-diff
|~ [dock path in-peer-data]
*form:tapp-trad
*form:tapp-async
::
:: Receive syscall result
::
++ handle-take
|~ sign
*form:tapp-trad
*form:tapp-async
--
::
++ create-tapp-all
@ -174,9 +174,9 @@
^- (quip move _this-tapp)
=. waiting (~(put to waiting) %poke in-poke-data)
?^ active
~& [%waiting-until-current-trad-finishes waiting]
~& [%waiting-until-current-async-finishes waiting]
`this-tapp
start-trad
start-async
::
:: Receive subscription request
::
@ -186,7 +186,7 @@
=. waiting (~(put to waiting) %peer path)
?^ active
`this-tapp
start-trad
start-async
::
:: Receive subscription response
::
@ -200,28 +200,28 @@
=. waiting (~(put to waiting) %diff [her app] pax in-peer-data)
?^ active
`this-tapp
start-trad
start-async
::
:: Pass response to trad
:: Pass response to async
::
++ sigh-httr
|= [=wire =httr:eyre]
^- (quip move _this-tapp)
(take-trad bowl `[wire %sigh httr])
(take-async bowl `[wire %sigh httr])
::
:: Failed http request
::
++ sigh-tang
|= [=wire =tang]
^- (quip move _this-tapp)
(oob-fail-trad %failed-sigh tang)
(oob-fail-async %failed-sigh tang)
::
++ wake-note
|= [=wire error=(unit tang)]
^- (quip move _this-tapp)
?^ error
(oob-fail-trad %timer-fire-failed u.error)
(take-trad bowl `[wire %wake ~])
(oob-fail-async %timer-fire-failed u.error)
(take-async bowl `[wire %wake ~])
::
++ wake-effect
|= [=wire error=(unit tang)]
@ -229,44 +229,44 @@
=. waiting (~(put to waiting) %take %wake error)
?^ active
`this-tapp
start-trad
start-async
::
:: Continue computing trad
:: Continue computing async
::
++ take-trad
|= =trad-input:trad-lib
++ take-async
|= =async-input:async-lib
^- (quip move _this-tapp)
=/ m tapp-trad
=/ m tapp-async
?~ active
:: Can't cancel HTTP requests, so we might get answers after end
:: of computation
::
?: ?=([~ @ %sigh *] in.trad-input)
?: ?=([~ @ %sigh *] in.async-input)
`this-tapp
~| %no-active-trad
~| ?~ in.trad-input
~| %no-active-async
~| ?~ in.async-input
~
wire.u.in.trad-input
wire.u.in.async-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
(take:eval:m u.active ost.bowl async-input)
=> .(active `(unit eval-form:eval:tapp-async)`active) :: TMI
=^ moves=(list move) this-tapp
?- -.eval-result.r
%next `this-tapp
%fail (fail-trad [contracts err]:eval-result.r)
%done (done-trad [contracts value]:eval-result.r)
%fail (fail-async [contracts err]:eval-result.r)
%done (done-async [contracts value]:eval-result.r)
==
[(weld moves.r moves) this-tapp]
::
:: Fails currently-running trad
:: Fails currently-running async
::
++ oob-fail-trad
(cury fail-trad contracts:(need active))
++ oob-fail-async
(cury fail-async contracts:(need active))
::
:: Called on trad failure
:: Called on async failure
::
++ fail-trad
++ fail-async
|= [contracts=(set contract) err=(pair term tang)]
^- (quip move _this-tapp)
%- %- slog
@ -275,47 +275,47 @@
leaf+(trip p.err)
q.err
==
(finish-trad contracts)
(finish-async contracts)
::
:: Called on trad success
:: Called on async success
::
++ done-trad
++ done-async
|= [contracts=(set contract) state=state-type]
^- (quip move _this-tapp)
=. app-state state
(finish-trad contracts)
(finish-async contracts)
::
:: Called whether trad failed or succeeded
:: Called whether async failed or succeeded
::
++ finish-trad
++ finish-async
|= contracts=(set contract)
^- (quip move _this-tapp)
=^ moves-1 this-tapp (cancel-contracts contracts)
=. active ~
=. waiting +:~(get to waiting)
=^ moves-2 this-tapp start-trad
=^ moves-2 this-tapp start-async
[(weld moves-1 moves-2) this-tapp]
::
:: Try to start next command
::
++ start-trad
++ start-async
^- (quip move _this-tapp)
?. =(~ active)
~| %trad-already-active !!
~| %async-already-active !!
=/ next=(unit command) ~(top to waiting)
?~ next
`this-tapp
=. active
:- ~
%- from-form:eval:tapp-trad
^- form:tapp-trad
%- from-form:eval:tapp-async
^- form:tapp-async
?- -.u.next
%poke (~(handle-poke handler bowl app-state) +.u.next)
%peer (~(handle-peer handler bowl app-state) +.u.next)
%diff (~(handle-diff handler bowl app-state) +.u.next)
%take (~(handle-take handler bowl app-state) +.u.next)
==
(take-trad bowl ~)
(take-async bowl ~)
::
:: Cancel outstanding contracts
::