ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-29 12:15:43 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branches 'philipcmonk/porcelain' and 'ohaitch/clay-tluc'

Browse Source 
Better gh app, various (known broken code)
improve performance for writing files, rebuilding tree
This commit is contained in:
Raymond Pasco 2016-06-06 13:29:55 -04:00
commit 70836c353b
16 changed files with 681 additions and 461 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

401
app/gh.hoon
View File

@ -1,118 +1,270 @@
:: This is a driver for the Github API v3.
:: This is a connector for the Github API v3.
::
:: You can interact with this in a few different ways:
::
:: - .^(%gx /=gh=/read{/endpoint}) or subscribe to
:: /scry/x/read{/endpoint} for authenticated reads.
:: - .^({type} %gx /=gh={/endpoint}) to read data or
:: .^(arch %gy /=gh={/endpoint}) to explore the possible
:: endpoints.
::
:: - subscribe to /scry/x/listen/{owner}/{repo}/{events...}
:: for webhook-powered event notifications. For event list,
:: see https://developer.github.com/webhooks/.
:: - subscribe to /listen/{owner}/{repo}/{events...} for
:: webhook-powered event notifications. For event list, see
:: https://developer.github.com/webhooks/.
::
:: See the %github app for example usage.
:: This is written with the standard structure for api
:: connectors, as described in lib/connector.hoon.
::
/? 314
/- gh, plan-acct
:: /ape/gh/split.hoon defines ++split, which splits a request
:: at the end of the longest possible endpoint.
::
// /%/split
/+ gh-parse, connector
::
!:
=> |%
++ move (pair bone card)
++ card
$% {$diff sub-result}
{$them wire (unit hiss)}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
==
::
:: Types of results we produce to subscribers.
::
++ sub-result
$% {$arch arch}
{$gh-issue issue:gh}
{$gh-list-issues (list issue:gh)}
{$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
{$json json}
{$null $~}
==
++ card
$% {$diff sub-result}
{$them wire (unit hiss)}
{$hiss wire {$~ $~} $httr {$hiss hiss}}
{$poke wire {ship $hood} $write-plan-account {knot plan-acct}}
==
::
:: Types of webhooks we expect.
::
++ hook-response
$% {$gh-issues issues:gh}
{$gh-issue-comment issue-comment:gh}
==
--
=+ connector=(connector move sub-result) :: Set up connector library
::
|_ {hid/bowl cnt/@ hook/(map @t {id/@t listeners/(set bone)})}
++ prep
|= a/(unit _+<+) ^- (quip move +>)
?^ a [~ +>(+<+ u.a)]
(peer-scry %x %read /user)
|_ $: hid/bowl
hook/(map @t {id/@t listeners/(set bone)}) :: map events to listeners
==
:: ++ prep _`. :: Clear state when code changes
::
:: This core manages everything related to a particular request.
:: List of endpoints
::
:: Each request has a particular 'style', which is currently
:: one of 'read', or 'listen'. ++scry handles all three types
:: of requests.
++ places
|= wir/wire
^- (list place:connector)
=+ (helpers:connector ost.hid wir "https://api.github.com")
=> |% :: gh-specific helpers
++ read-sentinel
|=(pax/path [ost %diff %arch `0vsen.tinel ~])
::
++ sigh-list-issues-x
|= jon/json
%+ bind ((ar:jo issue:gh-parse) jon)
|= issues/(list issue:gh)
gh-list-issues+issues
::
++ sigh-list-issues-y
|= jon/json
%+ bind ((ar:jo issue:gh-parse) jon)
|= issues/(list issue:gh)
:- `(shax (jam issues))
%- malt ^- (list {@ta $~})
:- [%gh-list-issues ~]
(turn issues |=(issue:gh [(rsh 3 2 (scot %ui number)) ~]))
--
:~ ^- place :: /
:* guard=$~
read-x=read-null
read-y=(read-static %issues ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place :: /issues
:* guard={$issues $~}
read-x=read-null
read-y=(read-static %mine %by-repo ~)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place :: /issues/mine
:* guard={$issues $mine $~}
read-x=(read-get /issues)
read-y=(read-static %gh-list-issues ~)
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place :: /issues/mine/<mark>
:* guard={$issues $mine @t $~}
read-x=read-null
read-y=read-sentinel
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place :: /issues/by-repo
:* guard={$issues $by-repo $~}
read-x=read-null
^= read-y
|= pax/path
=+ /(scot %p our.hid)/home/(scot %da now.hid)/web/plan
=+ .^({* acc/(map knot plan-acct)} %cx -)
::
((read-static usr:(~(got by acc) %github) ~) pax)
sigh-x=sigh-strange
sigh-y=sigh-strange
==
^- place :: /issues/by-repo/<user>
:* guard={$issues $by-repo @t $~}
read-x=read-null
read-y=|=(pax/path (get /users/[-.+>.pax]/repos))
sigh-x=sigh-strange
^= sigh-y
|= jon/json
%+ bind ((ar:jo repository:gh-parse) jon)
|= repos/(list repository:gh)
[~ (malt (turn repos |=(repository:gh [name ~])))]
==
^- place :: /issues/by-repo/<user>/<repo>
:* guard={$issues $by-repo @t @t $~}
read-x=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
read-y=|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues))
sigh-x=sigh-list-issues-x
sigh-y=sigh-list-issues-y
==
^- place :: /issues/by-repo/<user>/<repo>/<number>
:* guard={$issues $by-repo @t @t @t $~}
^= read-x
|=(pax/path (get /repos/[-.+>.pax]/[-.+>+.pax]/issues/[-.+>+>.pax]))
::
^= read-y
|= pax/path
%. pax
?: ((sane %tas) -.+>+>.pax)
read-sentinel
(read-static %gh-issue ~)
::
^= sigh-x
|= jon/json
%+ bind (issue:gh-parse jon)
|= issue/issue:gh
gh-issue+issue
::
sigh-y=sigh-strange
==
^- place :: /issues/by-repo/<u>/<r>/<n>/<mark>
:* guard={$issues $by-repo @t @t @t @t $~}
read-x=read-null
read-y=read-sentinel
sigh-x=sigh-strange
sigh-y=sigh-strange
==
==
::
++ help
|= {ren/care style/@tas pax/path}
=^ arg pax [+ -]:(split pax)
:: When a peek on a path blocks, ford turns it into a peer on
:: /scry/{care}/{path}. You can also just peer to this
:: directly.
::
:: We hand control to ++scry.
::
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care *} pax)
:_ +>.$ :_ ~
(read:connector ost.hid (places %read pax) i.pax t.pax)
::
:: HTTP response. We make sure the response is good, then
:: produce the result (as JSON) to whoever sent the request.
::
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
?. ?=({$read care @ *} way)
~& res=res
[~ +>.$]
=* style i.way
=* ren i.t.way
=* pax t.t.way
:_ +>.$ :_ ~
:+ ost.hid %diff
(sigh:connector (places ren style pax) ren pax res)
::
:: HTTP error. We just print it out, though maybe we should
:: also produce a result so that the request doesn't hang?
::
++ sigh-tang
|= {way/wire tan/tang}
^- {(list move) _+>.$}
%- (slog >%gh-sigh-tang< tan)
[[ost.hid %diff null+~]~ +>.$]
::
:: We can't actually give the response to pretty much anything
:: without blocking, so we just block unconditionally.
::
++ peek
|= {ren/@tas tyl/path}
^- (unit (unit (pair mark *)))
~ ::``noun/[ren tyl]
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: Webhook-powered event streams (/listen) ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
:: To listen to a webhook-powered stream of events, subscribe
:: to /listen/<user>/<repo>/<events...>
::
:: We hand control to ++listen.
::
++ peer-listen
|= pax/path
^- {(list move) _+>.$}
?. ?=({@ @ *} pax)
~& [%bad-listen-path pax]
[~ +>.$]
(listen pax)
::
:: This core handles event subscription requests by starting or
:: updating the webhook flow for each event.
::
++ listen
|= pax/path
=| mow/(list move)
=< abet:listen
|%
:: Resolve core.
::
++ abet
++ abet :: Resolve core.
^- {(list move) _+>.$}
[(flop mow) +>.$]
::
:: Append path to api.github.com and parse to a purl.
::
++ endpoint-to-purl
|= endpoint/path
(scan "https://api.github.com{<`path`endpoint>}" auri:epur)
::
:: Send a hiss
::
++ send-hiss
++ send-hiss :: Send a hiss
|= hiz/hiss
^+ +>
=+ wir=`wire`[(scot %ud cnt) ren (pack style arg) pax]
=+ new-move=[ost.hid %hiss wir `~ %httr [%hiss hiz]]
:: ~& [%sending-hiss new-move]
+>.$(mow [new-move mow])
::
:: Decide how to handle a request based on its style.
::
++ scry
^+ .
?+ style ~|(invalid-style+[style want=p:!>(*?($read $listen))] !!)
$read read
$listen listen
==
::
++ read (send-hiss (endpoint-to-purl pax) %get ~ ~)
=+ wir=`wire`[%x %listen pax]
+>.$(mow [[ost.hid %hiss wir `~ %httr [%hiss hiz]] mow])
::
:: Create or update a webhook to listen for a set of events.
::
++ listen
^+ .
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
=+ events=t.t.paf
=+ pax=pax :: TMI-proofing
?> ?=({@ @ *} pax)
=+ events=t.t.pax
|- ^+ +>+.$
?~ events
+>+.$
?: (~(has by hook) i.events)
=. +>+.$ (update-hook i.events)
$(events t.events)
=. +>+.$ (create-hook i.events)
$(events t.events)
$(+>+ (update-hook i.events), events t.events)
$(+>+ (create-hook i.events), events t.events)
::
:: Set up a webhook.
::
++ create-hook
|= event/@t
^+ +>
=+ paf=`path`(weld pax arg)
?> ?=({@ @ *} paf)
?> ?=({@ @ *} pax)
=+ clean-event=`tape`(turn (trip event) |=(a/@tD ?:(=('_' a) '-' a)))
=. hook
%+ ~(put by hook) (crip clean-event)
@ -122,7 +274,7 @@
[id (~(put in listeners) ost.hid)]
%- send-hiss
:* %+ scan
=+ [(trip i.paf) (trip i.t.paf)]
=+ [(trip i.pax) (trip i.t.pax)]
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:epur
%post ~ ~
@ -171,121 +323,4 @@
%+ turn (~(tap in listeners.u.hook-data))
|= ost/bone
[ost %diff response]
::
:: Here we handle PUT, POST, and DELETE requests. We probably
:: should return the result somehow, but that doesn't fit well
:: into poke semantics.
::
++ poke-gh-poke
|= {method/meth endpoint/(list @t) jon/json}
^- {(list move) _+>.$}
:_ +>.$ :_ ~
:* ost.hid %hiss /poke/[method] `~ %httr %hiss
~| stuff="https://api.github.com{<(path endpoint)>}"
(scan "https://api.github.com{<(path endpoint)>}" auri:epur)
method ~ `(taco (crip (pojo jon)))
==
::
:: When a peek on a path blocks, ford turns it into a peer on
:: /scry/{care}/{path}. You can also just peer to this
:: directly.
::
:: After some sanity checking we hand control to ++scry in
:: ++help.
::
++ peer-scry
|= pax/path
^- {(list move) _+>.$}
?> ?=({care ^} pax)
:: =- ~& [%peered -] -
[abet(cnt +(cnt))]:scry:(help i.pax i.t.pax t.t.pax)
::
:: Deconstruct an http request into a json result or error information
::
++ parse-json
|= res/httr ^- (each json {err/term inf/(list {term json})})
?~ r.res
[%| %empty-response code+(jone p.res) ~]
=+ jon=(rush q.u.r.res apex:poja)
?~ jon
[%| %bad-json code+(jone p.res) body+s+q.u.r.res ~]
?. =(2 (div p.res 100))
[%| %request-rejected code+(jone p.res) msg+u.jon ~]
[%& u.jon]
::
:: Anywhere recieved data should go besides the initiating request
::
++ side-effects
|= {pax/path rep/(each json ^)} ^- (list move)
?. ?=($& -.rep) ~ :: XX logging maybe?
?~ pax ~
?+ -.pax ~
$user
=+ =; jop usr=(need (jop p.rep))
(ot login+so url+(cu some (su aurf:urlp)) ~):jo
[ost.hid %poke user+~ [our.hid %hood] %write-plan-account ~.github usr]~
==
::
:: HTTP response. We make sure the response is good, then
:: produce the result (as JSON) to whoever sent the request.
::
++ sigh-httr
|= {way/wire res/httr}
^- {(list move) _+>.$}
?. ?=({@ care @ *} way)
~& bad-wire+[way res=res]
[~ +>.$]
=+ ^- {ren/care {syl/term arg/path} pax/path}
[i.t.way (need (puck i.t.t.way)) t.t.t.way]
:_ +>.$
=+ rep=(parse-json res)
:_ (side-effects pax rep)
:+ ost.hid %diff
?+ ren null+~
$x
?. ?=($& -.rep)
json+(jobe err+s+err.p.rep inf.p.rep)
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- sub-result
?~ arg
json+p.rep
=+ dir=((om:jo some) p.rep)
?~ dir
json+(jobe err+s+%json-not-object code+(jone p.res) body+p.rep ~)
=+ new-jon=(~(get by u.dir) i.arg)
$(arg t.arg, p.rep ?~(new-jon ~ u.new-jon))
::
$y
?. ?=($& -.rep)
~& [%scry-gh-y err.p.rep inf.p.rep]
arch+*arch
::
:: Once we know we have good data, we drill into the JSON
:: to find the specific piece of data referred to by 'arg'
::
|- ^- sub-result
=+ dir=((om:jo some) p.rep)
?~ dir
[%arch `(shax (jam p.rep)) ~]
?~ arg
[%arch `(shax (jam p.rep)) (~(run by u.dir) _~)]
=+ new-jon=(~(get by u.dir) i.arg)
$(arg t.arg, p.rep ?~(new-jon ~ u.new-jon))
==
::
++ sigh-tang
|= {way/wire tan/tang}
^- {(list move) _+>.$}
((slog >%gh-sigh-tang way< tan) `+>.$)
::
:: We can't actually give the response to pretty much anything
:: without blocking, so we just block unconditionally.
::
++ peek
|= {ren/@tas tyl/path}
^- (unit (unit (pair mark *)))
~ ::``noun/[ren tyl]
--

179
app/gh/split.hoon
View File

@ -1,179 +0,0 @@
!:
|%
:: Splits a path into the endpoint prefix and the remainder,
:: which is assumed to be a path within the JSON object. We
:: choose the longest legal endpoint prefix.
::
++ split
|= pax/path
:: =- ~& [%pax pax - (valid-endpoint pax)] -
=+ l=(lent pax)
|- ^- {path path}
?~ l
[~ pax]
?: ?=(valid-endpoint (scag l pax))
[(scag l pax) (slag l pax)]
$(l (dec l))
::
:: These are all the github GET endpoints, sorted with
:: `env LC_ALL=C sort`
::
++ valid-endpoint
$? {$emojis $~}
{$events $~}
{$feeds $~}
{$gists $public $~}
{$gists $starred $~}
{$gists gist-id/@ta $comments id/@ta $~}
{$gists gist-id/@ta $comments $~}
{$gists id/@ta $commits $~}
{$gists id/@ta $forks $~}
{$gists id/@ta $star $~}
{$gists id/@ta sha/@ta $~}
{$gists id/@ta $~}
{$gists $~}
{$gitignore $templates language/@ta $~}
{$gitignore $templates $~}
{$issues $~}
{$licenses license/@ta $~}
{$licenses $~}
{$meta $~}
{$networks onwer/@ta repo/@ta $events $~}
{$notifications $threads id/@ta $subscription $~}
{$notifications $threads id/@ta $~}
{$notifications $~}
{$organizations $~}
{$orgs org/@ta $events $~}
{$orgs org/@ta $hooks id/@ta $~}
{$orgs org/@ta $hooks $~}
{$orgs org/@ta $members username/@ta $~}
{$orgs org/@ta $members $~}
{$orgs org/@ta $memberships username/@ta $~}
{$orgs org/@ta $migrations id/@ta $archive $~}
{$orgs org/@ta $migrations id/@ta $~}
{$orgs org/@ta $migrations $~}
{$orgs org/@ta $'public_members' username/@ta $~}
{$orgs org/@ta $'public_members' $~}
{$orgs org/@ta $repos $~}
{$orgs org/@ta $teams $~}
{$orgs org/@ta $~}
{$'rate_limit' $~}
{$repos owner/@ta repo/@ta $assignees assignee/@ta $~}
{$repos owner/@ta repo/@ta $assignees $~}
{$repos owner/@ta repo/@ta $branches branch/@ta $~}
{$repos owner/@ta repo/@ta $branches $~}
{$repos owner/@ta repo/@ta $collaborators username/@ta $~}
{$repos owner/@ta repo/@ta $collaborators $~}
{$repos owner/@ta repo/@ta $comments id/@ta $~}
{$repos owner/@ta repo/@ta $comments $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $comments $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $status $~}
{$repos owner/@ta repo/@ta $commits ref/@ta $statuses $~}
{$repos owner/@ta repo/@ta $commits sha/@ta $~}
{$repos owner/@ta repo/@ta $commits $~}
{$repos owner/@ta repo/@ta $compare base-head/@ta $~}
{$repos owner/@ta repo/@ta $contents path/@ta $~}
{$repos owner/@ta repo/@ta $contributors $~}
{$repos owner/@ta repo/@ta $deployments id/@ta $statuses $~}
{$repos owner/@ta repo/@ta $deployments $~}
{$repos owner/@ta repo/@ta $events $~}
{$repos owner/@ta repo/@ta $forks $~}
{$repos owner/@ta repo/@ta $git $blobs sha/@ta $~}
{$repos owner/@ta repo/@ta $git $commits sha/@ta $~}
{$repos owner/@ta repo/@ta $git $refs ref/@ta $~}
{$repos owner/@ta repo/@ta $git $refs $~}
{$repos owner/@ta repo/@ta $git $tags sha/@ta $~}
{$repos owner/@ta repo/@ta $git $trees sha/@ta $~}
{$repos owner/@ta repo/@ta $hooks id/@ta $~}
{$repos owner/@ta repo/@ta $hooks $~}
{$repos owner/@ta repo/@ta $issues $comments id/@ta $~}
{$repos owner/@ta repo/@ta $issues $comments $~}
{$repos owner/@ta repo/@ta $issues $events id/@ta $~}
{$repos owner/@ta repo/@ta $issues $events $~}
{$repos owner/@ta repo/@ta $issues issue-number/@ta $events $~}
{$repos owner/@ta repo/@ta $issues number/@ta $comments $~}
{$repos owner/@ta repo/@ta $issues number/@ta $labels $~}
{$repos owner/@ta repo/@ta $issues number/@ta $~}
{$repos owner/@ta repo/@ta $issues $~}
{$repos owner/@ta repo/@ta $keys id/@ta $~}
{$repos owner/@ta repo/@ta $keys $~}
{$repos owner/@ta repo/@ta $labels name/@ta $~}
{$repos owner/@ta repo/@ta $labels $~}
{$repos owner/@ta repo/@ta $language $~}
{$repos owner/@ta repo/@ta $license $~}
{$repos owner/@ta repo/@ta $milestones number/@ta $labels $~}
{$repos owner/@ta repo/@ta $milestones number/@ta $~}
{$repos owner/@ta repo/@ta $milestones $~}
{$repos owner/@ta repo/@ta $notifications $~}
{$repos owner/@ta repo/@ta $pages $builds $latest $~}
{$repos owner/@ta repo/@ta $pages $builds $~}
{$repos owner/@ta repo/@ta $pages $~}
{$repos owner/@ta repo/@ta $pulls $comments id/@ta $~}
{$repos owner/@ta repo/@ta $pulls $comments $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $comments $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $commits $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $files $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $merge $~}
{$repos owner/@ta repo/@ta $pulls number/@ta $~}
{$repos owner/@ta repo/@ta $pulls $~}
{$repos owner/@ta repo/@ta $readme $~}
{$repos owner/@ta repo/@ta $releases $assets id/@ta $~}
{$repos owner/@ta repo/@ta $releases $latest $~}
{$repos owner/@ta repo/@ta $releases $tags tag/@ta $~}
{$repos owner/@ta repo/@ta $releases id/@ta $assets $~}
{$repos owner/@ta repo/@ta $releases id/@ta $~}
{$repos owner/@ta repo/@ta $releases $~}
{$repos owner/@ta repo/@ta $stargazers $~}
{$repos owner/@ta repo/@ta $stats $'commit_activity' $~}
{$repos owner/@ta repo/@ta $stats $contributors $~}
{$repos owner/@ta repo/@ta $stats $participation $~}
{$repos owner/@ta repo/@ta $stats $'punch_card' $~}
{$repos owner/@ta repo/@ta $subscribers $~}
{$repos owner/@ta repo/@ta $subscription $~}
{$repos owner/@ta repo/@ta $tags $~}
{$repos owner/@ta repo/@ta $teams $~}
{$repos owner/@ta repo/@ta archive-format/@ta ref/@ta $~}
{$repos owner/@ta repo/@ta $~}
{$repositories $~}
{$search $code $~}
{$search $issues $~}
{$search $repositories $~}
{$search $users $~}
{$teams id/@ta $members $~}
{$teams id/@ta $memberships username/@ta $~}
{$teams id/@ta $repos owner/@ta repo/@ta $~}
{$teams id/@ta $~}
{$user $emails $~}
{$user $followers $~}
{$user $following username/@ta $~}
{$user $following $~}
{$user $issues $~}
{$user $keys id/@ta $~}
{$user $keys $~}
{$user $memberships $orgs org/@ta $~}
{$user $memberships $orgs $~}
{$user $orgs $~}
{$user $repos $~}
{$user $starred owner/@ta repo/@ta $~}
{$user $starred $~}
{$user $subscriptions $~}
{$user $teams $~}
{$user username/@ta $orgs $~}
{$user $~}
{$users username/@ta $events $orgs org/@ta $~}
{$users username/@ta $events $public $~}
{$users username/@ta $events $~}
{$users username/@ta $followers $~}
{$users username/@ta $following target-user/@ta $~}
{$users username/@ta $following $~}
{$users username/@ta $gists $~}
{$users username/@ta $keys $~}
{$users username/@ta $'received_events' $public $~}
{$users username/@ta $'received_events' $~}
{$users username/@ta $starred $~}
{$users username/@ta $subscriptions $~}
{$users username/@ta $~}
{$users usernmae/@ta $repos $~}
{$users $~}
==
--

168
arvo/clay.hoon
View File

@ -18,7 +18,7 @@
can/(map path cage) :: new diffs
old/(map path $~) :: deleted files
== ::
++ cult (map duct rove) :: subscriptions
++ cult (jug rove duct) :: subscriptions
++ dojo :: domestic desk state
$: qyx/cult :: subscribers
dom/dome :: desk data
@ -175,8 +175,8 @@
:: -- `ref` is a possible request manager. For local desks, this is null.
:: For foreign desks, this keeps track of all pending foreign requests
:: plus a cache of the responses to previous requests.
:: -- `qyx` is the set of subscriptions, keyed by duct. These subscriptions
:: exist only until they've been filled.
:: -- `qyx` is the set of subscriptions, with listening ducts. These
:: subscriptions exist only until they've been filled.
:: -- `dom` is the actual state of the filetree. Since this is used almost
:: exclusively in `++ze`, we describe it there.
:: -- `dok` is a possible set of outstanding requests to ford to perform
@ -338,6 +338,20 @@
|= hen/duct
(emit hen %give %writ ~)
::
++ duct-lift :: for each duct
|* send/_|=({duct *} ..duct-lift)
|= {a/(set duct) arg/_+<+.send} ^+ ..duct-lift
=+ all=(~(tap by a))
|- ^+ ..duct-lift
?~ all ..duct-lift
=. +>.send ..duct-lift
$(all t.all, duct-lift (send i.all arg))
::
++ blub-all (duct-lift |=({a/duct $~} (blub a))) :: ship stop
++ blab-all (duct-lift blab) :: ship result
++ balk-all (duct-lift balk) :: read and send
++ bleb-all (duct-lift bleb) :: ship sequence
::
++ print-to-dill
|= {car/@tD tan/tank}
=+ bar=emit
@ -357,7 +371,8 @@
++ duce :: produce request
|= rov/rove
^+ +>
=. qyx (~(put by qyx) hen rov)
=. rov (dedupe rov)
=. qyx (~(put ju qyx) rov hen)
?~ ref
(mabe rov |=(@da (bait hen +<)))
|- ^+ +>+.$
@ -375,6 +390,32 @@
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
++ dedupe :: find existing alias
|= rov/rove ^- rove
=; ros/(list rove) ?+(ros rov {^ $~} i.ros)
?- -.rov
$sing ~
$next
?~ (case-to-aeon:ze q.p.rov) ~
%- ~(rep by qyx)
|= {{a/rove *} b/(list rove)} ^+ b
=- ?.(- b [a b])
?& ?=($next -.a)
=(p.a p.rov(q q.p.a))
?=(^ (case-to-aeon:ze q.p.a))
==
::
$many
?~ (case-to-aeon:ze p.q.rov) ~
%- ~(rep by qyx)
|= {{a/rove *} b/(list rove)} ^+ b
=- ?.(- b [a b])
?& ?=($many -.a)
=(a rov(p.q p.q.a))
?=(^ (case-to-aeon:ze p.q.a))
==
==
::
++ must-ergo
|= can/(list path)
^- (map term (pair @ud (set path)))
@ -411,22 +452,24 @@
::
++ ease :: release request
^+ .
=^ ros/(list rove) qyx
:_ (~(run by qyx) |=(a/(set duct) (~(del in a) hen)))
%- ~(rep by qyx)
|= {{a/rove b/(set duct)} c/(list rove)}
?.((~(has in b) hen) c [a c])
?~ ref
=+ rov=(~(get by qyx) hen)
?~ rov + :: XX handle?
=. qyx (~(del by qyx) hen)
(mabe u.rov |=(@da (best hen +<)))
=. qyx (~(del by qyx) hen)
|- ^+ +.$
=> .(ref `(unit rind)`ref) :: XX TMI
?: =(~ ros) + :: XX handle?
|- ^+ +>
?~ ros +>
$(ros t.ros, +> (mabe i.ros |=(@da (best hen +<))))
^+ ..ease
=+ nux=(~(get by fod.u.ref) hen)
?~ nux +.$
=. +.$
=< ?>(?=(^ ref) .)
(send-over-ames hen [(scot %ud u.nux) ~] her u.nux syd ~)
%= +.$
fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
?~ nux ..ease
=: fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
(send-over-ames hen [(scot %ud u.nux) ~] her u.nux syd ~)
::
++ eave :: subscribe
|= rav/rave
@ -1183,76 +1226,77 @@
::
++ wake :: update subscribers
^+ .
=+ xiq=(~(tap by qyx) ~)
=| xaq/(list {p/duct q/rove})
=+ xiq=(~(tap by qyx))
=| xaq/(list {p/rove q/(set duct)})
|- ^+ ..wake
?~ xiq
..wake(qyx (~(gas by *cult) xaq))
?- -.q.i.xiq
?: =(~ q.i.xiq) $(xiq t.xiq, xaq xaq) :: drop forgotten
?- -.p.i.xiq
$sing
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.q.i.xiq))
=+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.p.i.xiq))
?^ cas
%= $
xiq t.xiq
..wake ?~ u.cas (blub p.i.xiq)
(blab p.i.xiq p.q.i.xiq %& u.u.cas)
..wake ?~ u.cas (blub-all q.i.xiq ~)
(blab-all q.i.xiq p.p.i.xiq %& u.u.cas)
==
=+ nao=(case-to-aeon:ze q.p.q.i.xiq)
=+ nao=(case-to-aeon:ze q.p.p.i.xiq)
?~ nao $(xiq t.xiq, xaq [i.xiq xaq])
:: ~& %reading-at-aeon
=+ vid=(read-at-aeon:ze u.nao p.q.i.xiq)
=+ vid=(read-at-aeon:ze u.nao p.p.i.xiq)
:: ~& %red-at-aeon
?~ vid
:: ?: =(0 u.nao)
:: ~& [%oh-poor `path`[syd '0' r.p.q.i.xiq]]
:: ~& [%oh-poor `path`[syd '0' r.p.p.i.xiq]]
:: $(xiq t.xiq)
:: ~& [%oh-well desk=syd mood=p.q.i.xiq aeon=u.nao]
:: ~& [%oh-well desk=syd mood=p.p.i.xiq aeon=u.nao]
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.vid p.q.i.xiq))
$(xiq t.xiq, ..wake (balk-all q.i.xiq u.vid p.p.i.xiq))
::
$next
=* mun p.q.i.xiq
:: =* dat q.q.i.xiq XX can't fuse right now
?~ q.q.i.xiq
=* mun p.p.i.xiq
:: =* dat q.p.i.xiq XX can't fuse right now
?~ q.p.i.xiq
=+ ver=(aver mun)
?~ ver
$(xiq t.xiq, xaq [i.xiq xaq])
?~ u.ver
$(xiq t.xiq, ..wake (blub p.i.xiq))
$(xiq t.xiq, xaq [i.xiq(q.q u.ver) xaq])
$(xiq t.xiq, ..wake (blub-all q.i.xiq ~))
$(xiq t.xiq, xaq [i.xiq(q.p u.ver) xaq])
=+ var=(aver mun(q [%ud let.dom]))
?~ var
~& [%oh-noes mood=mun letdom=let.dom]
$(xiq t.xiq)
?~ u.var
$(xiq t.xiq, ..wake (blab p.i.xiq mun %& %null [%atom %n ~] ~))
?: (equivalent-data:ze u.q.q.i.xiq u.u.var)
$(xiq t.xiq, ..wake (blab-all q.i.xiq mun %& %null [%atom %n ~] ~))
?: (equivalent-data:ze u.q.p.i.xiq u.u.var)
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (blab p.i.xiq mun u.u.var))
$(xiq t.xiq, ..wake (blab-all q.i.xiq mun u.u.var))
::
$many
=+ mot=`moot`q.q.i.xiq
=+ mot=`moot`q.p.i.xiq
=+ nab=(case-to-aeon:ze p.mot)
?~ nab
$(xiq t.xiq, xaq [i.xiq xaq])
=+ huy=(case-to-aeon:ze q.mot)
?~ huy
=+ ptr=[%ud +(let.dom)]
=. p.mot [%ud +(let.dom)]
%= $
xiq t.xiq
xaq [[p.i.xiq [%many p.q.i.xiq ptr q.mot r.mot s.mot]] xaq]
xaq [i.xiq(q.p mot) xaq]
..wake =+ ^= ear
(lobes-at-path:ze let.dom r.mot)
?: =(s.mot ear) ..wake
(bleb p.i.xiq let.dom ?:(p.q.i.xiq ~ `[u.nab let.dom]))
(bleb-all q.i.xiq let.dom ?:(p.p.i.xiq ~ `[u.nab let.dom]))
==
%= $
xiq t.xiq
..wake =- (blub:- p.i.xiq)
..wake =- (blub-all:- q.i.xiq ~)
=+ ^= ear
(lobes-at-path:ze u.huy r.mot)
?: =(s.mot ear) (blub p.i.xiq)
(bleb p.i.xiq +(u.nab) ?:(p.q.i.xiq ~ `[u.nab u.huy]))
?: =(s.mot ear) (blub-all q.i.xiq ~)
(bleb-all q.i.xiq +(u.nab) ?:(p.p.i.xiq ~ `[u.nab u.huy]))
==
==
++ drop-me
@ -1596,7 +1640,7 @@
=+ ^= yak
%- aeon-to-yaki
let.dom
?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])
?^(r.mun ~ !!) :: [~ %w !>([t.yak (forge-nori yak)])])-all
(query(ank.dom ank:(descend-path:(zu ank.dom) r.mun)) p.mun)
::
++ read-u
@ -1690,6 +1734,7 @@
~
=+ yak=(tako-to-yaki u.tak)
=+ len=(lent pax)
:: ~& read-z+[yon=yon qyt=~(wyt by q.yak) pax=pax]
=+ ^- descendants/(list (pair path lobe))
:: ~& %turning
:: =- ~& %turned -
@ -2582,7 +2627,7 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: $0 :: vane version
$: $1 :: vane version
ruf/raft :: revision tree
== ::
|= {now/@da eny/@ ski/sley} :: activate
@ -2773,9 +2818,34 @@
~
::
++ load
|= old/{$0 ruf/raft}
=> |%
++ cult-0 (map duct rove)
++ dojo-0 (cork dojo |=(a/dojo a(qyx *cult-0)))
++ rede-0 (cork rede |=(a/rede a(qyx *cult-0)))
++ room-0 (cork room |=(a/room a(dos (~(run by dos.a) dojo-0))))
++ rung-0 (cork rung |=(a/rung a(rus (~(run by rus.a) rede-0))))
++ raft-0
%+ cork raft
|=(a/raft a(fat (~(run by fat.a) room-0), hoy (~(run by hoy.a) rung-0)))
++ axle $%({$0 ruf/raft-0} {$1 ruf/raft})
--
|= old/axle
^+ ..^$
..^$(ruf ruf.old)
?- -.old
$1 ..^$(ruf ruf.old)
$0 =/ cul
|= a/cult-0 ^- cult
%- ~(gas ju *cult)
(turn (~(tap by a)) |=({p/duct q/rove} [q p]))
=/ rom
=+ doj=|=(a/dojo-0 a(qyx (cul qyx.a)))
|=(a/room-0 a(dos (~(run by dos.a) doj)))
=/ run
=+ red=|=(a/rede-0 a(qyx (cul qyx.a)))
|=(a/rung-0 a(rus (~(run by rus.a) red)))
=+ r=ruf.old
$(old [%1 r(fat (~(run by fat.r) rom), hoy (~(run by hoy.r) run))])
==
::
++ scry :: inspect
|= {fur/(unit (set monk)) ren/@tas his/ship syd/desk lot/coin tyl/path}
@ -2796,7 +2866,7 @@
?: ?=($& -.u.u.-) ``p.u.u.-
~
::
++ stay [%0 ruf]
++ stay [%1 ruf]
++ take :: accept response
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]

21
arvo/eyre.hoon
View File

@ -571,6 +571,7 @@
bolo :: all vane state
== ::
=* bol ->
~% %eyre-y ..is ~
|%
++ abet :: resolve moves
^- {(list move) bolo}
@ -721,7 +722,7 @@
:: [%of @ ^] (get-ack:(ire-ix p.tee) q.tee hon)
:: ==
++ axon :: accept response
|= {tee/whir typ/span sih/sign}
|= {tee/whir sih/sign}
^+ +>
=. our ?~(hov our u.hov) :: XX
?: &(?=({?($of $ow) ^} tee) !(~(has by wix) p.tee))
@ -750,7 +751,7 @@
=+ cuf=`cuft`+>.sih
?- -.cuf
?($coup $reap)
~? ?=($lens r.q.tee) hen=hen^hcuf=-.cuf
:: ~? ?=($lens r.q.tee) hen=hen^hcuf=-.cuf
(get-ack:(ire-ix p.tee) q.tee ?~(p.cuf ~ `[-.cuf u.p.cuf]))
::
$doff !!
@ -862,6 +863,8 @@
++ norm-beak |=(bek/beak ?+(r.bek bek {$ud $0} bek(r da+now)))
++ emule
|= a/_|?(..emule) ^+ ..emule
?: [unsafe=|]
(a)
=+ mul=(mule a)
?~ -.mul p.mul
(fail 500 0v0 >%exit< p.mul)
@ -984,6 +987,7 @@
::
::
++ handle
~% %eyre-h ..is ~
|_ $: {hat/hart pok/pork quy/quay} :: purl parsed url
{cip/clip aut/?} :: client ip nonymous?
{mef/meth maf/math bod/(unit octs)} :: method+headers+body
@ -1033,7 +1037,7 @@
$bake
=+ req=[%bake mar=q.pez [r s]:pez]
=+ red=req(mar %red-quri)
(exec-live p.pez -.s.pez `silk`[%alts ~[red req]])
(exec-live p.pez -.s.pez `silk`[%alts ~[req red]])
::
$red
=+ url=(earn hat pok(p [~ %html]) quy)
@ -1440,6 +1444,7 @@
::
++ oryx-to-ixor |=(a/oryx (rsh 3 1 (scot %p (end 6 1 (shas %ire a)))))
++ ya :: session engine
~% %eyre-y ..is ~
=| {ses/hole cyst}
=* cyz ->
|%
@ -1469,11 +1474,11 @@
him her
aut (~(put in aut) her)
..ya
~& logon+[our her ses]
:: ~& logon+[our her ses]
?. =(our her)
..ya
=+ sap=(~(get by sop) ses)
~& sap
:: ~& sap+sap
?. ?=({$~ @ $|} sap)
..ya
(ames-gram -.u.sap aut+~ ses)
@ -1510,6 +1515,7 @@
--
::
++ ix
~% %eyre-x ..is ~
=| {ire/ixor stem}
=* sem ->
|%
@ -1684,6 +1690,7 @@
++ print-subs |=({a/dock b/path} "{<p.a>}/{(trip q.a)}{(spud b)}")
--
++ vi :: auth engine
~% %eyre-v ..is ~
|_ $: {usr/iden dom/path}
cor/(unit $@($~ vase))
req/(qeu {p/duct q/mark r/vase:hiss})
@ -1970,8 +1977,6 @@
?~ tee ~& [%e %lost -.q.hin hen] [~ ..^$]
=^ mos bol
=< abet
%^ axon:~(adit ye [hen [now eny our sky] ~] bol) u.tee
(~(peek ut p.hin) %free 3)
q.hin
(axon:~(adit ye [hen [now eny our sky] ~] bol) u.tee q.hin)
[mos ..^$]
--

74
arvo/ford.hoon
View File

@ -14,12 +14,18 @@
$% $: $c :: to %clay
$% {$warp p/sock q/riff} ::
== == ::
$: $g :: to %clay
$: $f :: to %ford
$% {$exec p/@p q/(unit bilk)} ::
== == ::
$: $g :: to %gall
$% {$deal p/sock q/cush} ::
== == == ::
++ sign :: in result $<-
$% $: $c :: by %clay
$% {$writ p/riot} ::
== == ::
$: $f :: by %ford
$% {$made p/@uvH q/gage} ::
== == ::
$: $g :: by %gall
$% {$unto p/cuft} ::
@ -64,6 +70,7 @@
$% {$hood p/calm q/(pair beam cage) r/hood} :: compile
{$bake p/calm q/(pair mark beam) r/(unit vase)} :: load
{$boil p/calm q/(trel coin beam beam) r/vase} :: execute
{$path p/calm q/beam r/(unit beam)} :: -to/ transformation
{$slit p/calm q/{p/span q/span} r/span} :: slam type
{$slim p/calm q/{p/span q/twig} r/(pair span nock)}:: mint
{$slap p/calm q/{p/vase q/twig} r/vase} :: compute
@ -91,6 +98,7 @@
$hood ?>(?=($hood -.cax) r.cax)
$bake ?>(?=($bake -.cax) r.cax)
$boil ?>(?=($boil -.cax) r.cax)
$path ?>(?=($path -.cax) r.cax)
$slap ?>(?=($slap -.cax) r.cax)
$slam ?>(?=($slam -.cax) r.cax)
$slim ?>(?=($slim -.cax) r.cax)
@ -205,6 +213,7 @@
+>.$
?- -.+.sih
$writ (~(resp zo [num u.tus]) [van ren bem] p.+.sih)
$made (~(resm zo [num u.tus]) [van ren bem] [p q]:+.sih)
$unto
?+ -.p.+.sih ~|(ford-strange-unto+-.p.+.sih !!)
$diff (~(resd zo [num u.tus]) [van ren bem] p.p.+.sih)
@ -251,7 +260,7 @@
+>.$(mow ?.(ask mow :_(mow [hen %give %news dep])))
=+ dap=(~(get by deh.bay) dep)
?~ dap ~&(dep-missed+dep +>.$) :: XX ~| !!
:: ~& awap+[dep u.dap]
~& awap+[dep u.dap]
?- -.u.dap
$done +>.$(mow ?.(ask mow :_(mow [hen %give %news dep])))
$sent
@ -315,7 +324,13 @@
?+ van ~&(%camp-stub !!)
$g
:+ %pass (camp-wire +<)
[%g [%deal [our p.bem] q.bem [%peer %scry ren (flop s.bem)]]]
=+ ^= tyl
?. ?=($x ren)
s.bem
?> ?=(^ s.bem)
t.s.bem
[%g [%deal [our p.bem] q.bem [%peer %scry ren (flop tyl)]]]
::
$c
:+ %pass (camp-wire +<)
@ -587,11 +602,11 @@
::
++ fade :: compile to hood
~/ %fade
|= {cof/cafe for/mark bem/beam}
|= {cof/cafe bem/beam}
:: ~& fade+(tope bem)
^- (bolt hood)
%+ cool |.(leaf+"ford: fade {<[(tope bem)]>}")
%+ cope (liar cof %*(. bem s [for s.bem]))
%+ cope (liar cof %*(. bem s [%hoon s.bem]))
|= {cof/cafe cay/cage}
%+ (clef %hood) (fine cof bem(r [%ud 0]) cay)
^- (burg (pair beam cage) hood)
@ -608,9 +623,15 @@
~/ %fame
|= {cof/cafe bem/beam}
^- (bolt beam)
=; une/(bolt (unit beam))
%+ cope une
|= {cof/cafe bom/(unit beam)} ^- (bolt beam)
?^ bom (fine cof u.bom)
(flaw cof leaf+"fame: no {<(tope bem)>}" ~)
%+ (clef %path) (fine cof bem)
|= {cof/cafe bem/beam}
=^ pax bem [(flop s.bem) bem(s ~)]
|^ (cope opts (flux |=(a/(unit beam) (fall a bem))))
::
|^ opts
++ opts :: search unless done
^- (bolt (unit beam))
?^ pax (wide(pax t.pax) (tear i.pax))
@ -1019,6 +1040,8 @@
::
++ lear :: load core
|= {cof/cafe bem/beam} ^- (bolt vase)
%+ cope (lamp cof bem)
|= {cof/cafe bem/beam}
(leap cof many+~ bem bem)
::
++ leap :: XX load with path
@ -1030,7 +1053,7 @@
|= {cof/cafe arg/coin bem/beam bom/beam}
%+ cope (fame cof bem)
|= {cof/cafe bem/beam}
(cope (fade cof %hoon bem) abut:(meow bom arg))
(cope (fade cof bem) abut:(meow bom arg))
::
++ lend :: load arch
|= {cof/cafe bem/beam}
@ -1091,10 +1114,12 @@
++ lime :: load beam
|= {cof/cafe for/mark arg/coin bem/beam}
^- (bolt vase)
%+ coop (leap cof arg [-.bem /[for]/ren] bem)
|= cof/cafe ^- (bolt vase)
%+ cope (lima cof for bem)
|= {cof/cafe vux/(unit vase)}
?^ vux (fine cof u.vux)
(leap cof arg [-.bem /[for]/ren] bem)
(flaw cof leaf+"ford: no {<for>} at {<(tope bem)>}" ~)
::
++ link :: translate
~/ %link
@ -1618,7 +1643,7 @@
=. arg ?.(lit arg many+~)
(cope (make cof %bake q.hon arg how) furl)
%+ cool |.(leaf+"ford: hook {<q.hon>} {<(tope how)>}")
%+ cope (fade cof %hoon how)
%+ cope (fade cof how)
|= {cof/cafe hyd/hood}
%+ cope (abut:(meow how arg) cof hyd)
;~(cope (lake | q.hon) (flux |=(a/vase [q.hon a])))
@ -1636,7 +1661,7 @@
$(bir t.bir)
%+ cope (fame cof (hone %sur i.bir))
|= {cof/cafe bem/beam}
%+ cope (fade cof %hoon bem)
%+ cope (fade cof bem)
|= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..head}
@ -1668,7 +1693,7 @@
$(bir t.bir)
%+ cope (fame cof (hone %lib i.bir))
|= {cof/cafe bem/beam}
%+ cope (fade cof %hoon bem)
%+ cope (fade cof bem)
|= {cof/cafe hyd/hood}
%+ cope (apex(how bem, boy ~) cof hyd)
|= {cof/cafe sel/_..neck}
@ -1692,7 +1717,7 @@
%+ cope (lend cof p.hop)
|= {cof/cafe arc/arch}
?: (~(has by dir.arc) %hoon)
%+ cope (fade cof %hoon p.hop)
%+ cope (fade cof p.hop)
|= {cof/cafe hyd/hood}
%+ cope (apex(boy ~) cof hyd)
(flux |=(sel/_..wilt sel(boy [[%tow boy.sel] boy])))
@ -1775,14 +1800,33 @@
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] r.u.rot))
::
++ resd
++ resd :: take %diff
|= {{van/vane ren/care bem/beam} cag/cage}
^+ ..zo
?> ?=($g van)
?: |(!?=($x ren) =(-.s.bem p.cag))
=. kig (~(del in kig) +<-.$)
=. mow :_(mow [hen (cancel van ren bem)])
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] cag))
=. mow
:_ mow
:^ hen %pass (camp-wire van ren bem)
[%f %exec our ~ bek %cast ((hard mark) -.s.bem) %$ cag]
..zo
::
++ resm :: take %made
|= {{van/vane ren/care bem/beam} dep/@uvH gag/gage} :: XX depends?
^+ ..zo
?> ?=($g van)
=. kig (~(del in kig) +<-.$)
=. mow :_(mow [hen (cancel van ren bem)])
?: ?=($| -.gag)
amok:(expo [%made dep %| leaf+"ford-scry-made-fail" p.gag])
?: ?=($tabl -.gag)
amok:(expo [%made dep %| leaf+"ford-scry-made-strange" ~])
=+ (cat 3 van ren)
exec(keg (~(put by keg) [- bem] cag))
exec(keg (~(put by keg) [- bem] p.gag))
::
++ syve
^- sley

12
arvo/gall.hoon
View File

@ -1,5 +1,4 @@
!: :: %gall, agent execution
!? 163
::::
|= pit/vase
@ -638,9 +637,14 @@
++ ap-peek
|= {ren/@tas tyl/path}
^- (unit (unit cage))
=+ ?. ?=($x ren)
[mar=%$ tyl=tyl]
=+ `path`(flop tyl)
?> ?=(^ -)
[mar=i tyl=(flop t)]
=+ cug=(ap-find %peek ren tyl)
?~ cug
((slog leaf+"peek find fail" >tyl< ~) [~ ~])
((slog leaf+"peek find fail" >tyl< >mar< ~) [~ ~])
=^ arm +>.$ (ap-farm q.u.cug)
?: ?=($| -.arm) ((slog leaf+"peek farm fail" p.arm) [~ ~])
=^ zem +>.$ (ap-slam q.u.cug p.arm !>([ren (slag p.u.cug tyl)]))
@ -652,6 +656,8 @@
=+ caz=(spec (slot 7 p.zem))
?. &(?=({p/@ *} q.caz) ((sane %tas) p.q.caz))
((slog leaf+"scry: malformed cage" ~) [~ ~])
?. =(mar p.q.caz)
[~ ~]
``[p.q.caz (slot 3 caz)]
==
::
@ -1306,6 +1312,8 @@
~
?. (~(has by bum:(~(got by pol.all) who)) syd)
[~ ~]
?. ?=(^ tyl)
~
(mo-peek:(mo-abed:mo who *duct) syd high+`who ren tyl)
::
++ stay :: save w+o cache

167
lib/connector.hoon Normal file
View File

@ -0,0 +1,167 @@
:: This is a library for writing API connectors.
::
:: The basic flow is as follows:
:: -- define a list of `++place`s, which specify the exported
:: interface.
:: -- in `++peer-scry` in the connector app, call `++read` in
:: this library to match to the appropriate place and
:: produce a move (usually either an immediate response or
:: an http request to the api).
:: -- in `++sigh-httr` in the connector app, call `++sigh` in
:: this library to handle the response according to the
:: place.
|* {move/mold sub-result/mold}
=> |%
:: A place consists of:
:: -- `guard`, the type of the paths we should match. For
:: example, to match `/issues/<user>/<repo>` use
:: `{$issues @t @t $~}`.
:: -- `read-x`, called when someone tries to read the
:: place with care `%x`. Should produce a single move,
:: usually either a `%diff` response if we can
:: immediately answer or a `%hiss` http request if we
:: need to make a request to the api. See the
:: `++read-*` functions in `++helpers` for some common
:: handlers.
:: -- `read-y`, same as `read-x` except with care `%y`.
:: -- `sigh-x`, called when an http response comes back on
:: this place. You're given the json of the result, and
:: you should produce either a result or null. Null
:: represents an error. If you didn't create an http
:: request in `read-x`, then this should never be
:: called. Use `++sigh-strange` from `++helpers` to
:: unconditionally signal an error.
:: -- `sigh-y`, same as `sigh-x` except with care `%y`.
:: Note that a `%y` request must produce an arch, unlike
:: a `%x` request, which may produce data of any mark.
::
++ place
$: guard/mold
read-x/$-(path move)
read-y/$-(path move)
sigh-x/$-(jon/json (unit sub-result))
sigh-y/$-(jon/json (unit arch))
==
--
|%
:: Generic helpers for place definitions
::
++ helpers
|= {ost/bone wir/wire api-url/tape}
|%
:: Produce null. Used as `++read-x` in places which are pure
:: directories. `++sigh-x` should be `++sigh-strange`.
::
++ read-null |=(pax/path [ost %diff %null ~])
::
:: Produce an arch with the given list of children. Used as
:: `++read-y` in places which have a static list of (known)
:: children rather than having to ask the api. `++sigh-y`
:: should be `++sigh-strange`.
::
++ read-static
|= children/(list @t)
|= pax/path
[ost %diff %arch ~ (malt (turn children |=(@t [+< ~])))]
::
:: Produce an api request to the given path. Use this if the
:: endpoint is static. If the endpoint depends on parameters
:: in the path, use `++get`. For example:
:: `|=(pax/path (get /users/[+<.pax]/repos))`.
::
++ read-get
|= endpoint/path
|= pax/path
(get endpoint)
::
:: Make an api request to the specified endpoint.
::
++ get
|= endpoint/path
^- move
:* ost %hiss wir `~ %httr %hiss
(endpoint-to-purl endpoint) %get ~ ~
==
::
:: Convert an endpoint path to a purl.
::
++ endpoint-to-purl
|= endpoint/path
(scan (weld api-url <`path`endpoint>) auri:epur)
::
:: Return error. Used when no http response is expected.
::
++ sigh-strange |=(jon/json ~)
--
::
:: Handles one-time requests by mapping them to their handling,
:: either `read-x` or `read-y`, in `places`.
::
++ read
|= {ost/bone places/(list place) ren/care pax/path}
^- move
?~ places
~& [%strange-path pax]
(move [ost %diff ?+(ren !! $x null+~, $y arch+*arch)])
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
(?+(ren !! $x read-x.i.places, $y read-y.i.places) pax)
::
:: Handles http responses sent in `++read` by mappig them to
:: their handling, either `sigh-x` or `sigh-y`, in `places`.
::
++ sigh
|= {places/(list place) ren/care pax/path res/httr}
^- sub-result
=< ?+(ren ~|([%invalid-care ren] !!) $x sigh-x, $y sigh-y)
|%
++ sigh-x
?~ r.res
~& [err+%empty-response code+p.res]
null+~
=+ jon=(rush q.u.r.res apex:poja)
?~ jon
~& [err+%bad-json code+p.res body+q.u.r.res]
null+~
?. =(2 (div p.res 100))
~& [err+%request-rejected code+p.res msg+u.jon]
null+~
|- ^- sub-result
?~ places
~&([%sigh-strange-path pax] (sub-result null+~))
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
=+ (sigh-x.i.places u.jon)
?~ -
~& [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
(sub-result null+~)
u.-
::
++ sigh-y
?~ r.res
~& [err+s+%empty-response code+(jone p.res)]
arch+*arch
=+ jon=(rush q.u.r.res apex:poja)
?~ jon
~& [err+s+%bad-json code+(jone p.res) body+s+q.u.r.res]
arch+*arch
?. =(2 (div p.res 100))
~& [err+s+%request-rejected code+(jone p.res) msg+u.jon]
arch+*arch
%- sub-result
|- ^- {$arch arch}
?~ places
~&([%sigh-strange-path pax] arch+*arch)
=+ match=((soft guard.i.places) pax)
?~ match
$(places t.places)
=+ (sigh-y.i.places u.jon)
?~ -
~& [err+s+%response-not-valid pax+pax code+(jone p.res) msg+u.jon]
arch+*arch
arch+u.-
--
--

30
lib/gh-parse.hoon
View File

@ -101,6 +101,9 @@
==
++ issue
^- $-(json (unit issue:gh))
|= jon/json
=- (bind - |*(issue/* `issue:gh`[jon issue]))
%. jon
=+ jo
%- ot :~
'url'^so
@ -145,4 +148,31 @@
'body'^so
==
++ id no:jo
++ print-issue
|= issue:gh
^- wain
=+ c=(cury cat 3)
:* :(c 'title: ' title ' (#' (rsh 3 2 (scot %ui number)) ')')
(c 'state: ' state)
(c 'creator: ' login.user)
(c 'created-at: ' created-at)
(c 'assignee: ' ?~(assignee 'none' login.u.assignee))
::
%+ c 'labels: '
?~ labels ''
|- ^- @t
?~ t.labels name.i.labels
:(c name.i.t.labels ', ' $(t.labels t.t.labels))
::
(c 'comments: ' (rsh 3 2 (scot %ui comments)))
(c 'url: ' url)
''
%+ turn (lore body) :: strip carriage returns
|= l/@t
?: =('' l)
l
?. =('\0d' (rsh 3 (dec (met 3 l)) l))
l
(end 3 (dec (met 3 l)) l)
==
--

14
mar/gh/issue.hoon Normal file
View File

@ -0,0 +1,14 @@
/- gh
/+ gh-parse
|_ issue/issue:gh
++ grab
|%
++ noun issue:gh
--
++ grow
|%
++ json raw.issue
++ mime [/txt/plain (taco (crip <issue>))]
++ txt (print-issue:gh-parse issue)
--
--

5
mar/gh/issues.hoon
View File

@ -77,11 +77,12 @@
title.issue.issues
==
==
^- speech:talk
:* %api %github
login.sender.issues
(need (epur url.sender.issues))
(rash html-url.sender.issues aurf:epur)
txt txt
(need (epur url.issue.issues))
(rash html-url.issue.issues aurf:epur)
%- jobe
%+ welp
:~ repository+s+name.repository.issues

17
mar/gh/list-issues.hoon Normal file
View File

@ -0,0 +1,17 @@
/- gh
/+ gh-parse
|_ issues/(list issue:gh)
++ grab
|%
++ noun (list issue:gh)
--
++ grow
|%
++ json [%a (turn issues |=(issue:gh raw))]
++ mime [/txt/plain (taco (crip <issues>))]
++ txt =- ?~ - - ->
%+ roll (turn issues print-issue:gh-parse)
|= {a/wain b/wain}
:(welp b ~['----------------------------------------'] a)
--
--

1
mar/lens/command.hoon
View File

@ -7,6 +7,7 @@
++ json
|= jon/^json
^- command:lens
~| jon=jon
%- need
%. jon
=> [. jo]

17
mar/urb.hoon
View File

@ -5,14 +5,6 @@
/= urb-wasp-data-js /: /%/wasp-data /js/
!:
|_ {{dep/@uvH hed/marl} {dep-bod/@uvH bod/marl}}
++ linked-deps-js
'''
urb.waspAll = function(sel){
[].map.call(document.querySelectorAll(sel), urb.waspElem)
}
urb.waspAll('script'); urb.waspAll('link')
'''
++ grow :: convert to
|%
++ mime [/text/html (taco html)] :: convert to %mime
@ -30,11 +22,12 @@
:~ ;script@"/~/on/{<dep>}.js"(urb_injected "", async "", onload "setTimeout(urb.onDep,2000)");
;script(urb_injected "")
;- (trip urb-wasp-data-js)
; window.urb = window.urb || \{}
; urb.waspWait = []
; urb.wasp = urb.wasp || [].push.bind(urb.waspWait)
; urb.onDep = function()\{
; urb.waspDeps();
; urb.waspData({(pojo %s (scot %uv dep-bod))});
;- (trip linked-deps-js)
; urb.waspWait.map(urb.wasp)
; urb.onLoadUrbJS()
; urb.waspData({(pojo %s (scot %uv dep-bod))})
; }
==
==

29
mar/urb/wasp-data.js
View File

@ -1,7 +1,11 @@
window.urb = window.urb || {}
urb.waspWait = []
urb.wasp = urb.wasp || [].push.bind(urb.waspWait)
// debugging
urb.verb = false
urb.sources = {}
urb.waspDeps = function(){
urb.deps.map(function(a){urb.sources[a] = "dep"})
}
@ -33,12 +37,21 @@ urb.waspData = function(dep){
urb.datadeps[dep] = true
urb.wasp(dep)
}
urb.ondataupdate = urb.onupdate // overridable
var _onupdate = urb.onupdate
urb.onupdate = function(dep){
if(urb.verb)
console.log("update", urb.datadeps[dep] ? "data" : "full", dep, urb.sources[dep])
if(urb.datadeps[dep]) urb.ondataupdate(dep)
else _onupdate(dep)
urb.onLoadUrbJS = function(){
urb.ondataupdate = urb.ondataupdate || urb.onupdate // overridable
var _onupdate = urb.onupdate
urb.onupdate = function(dep){
if(urb.verb)
console.log("update", urb.datadeps[dep] ? "data" : "full", dep, urb.sources[dep])
if(urb.datadeps[dep]) urb.ondataupdate(dep)
else _onupdate(dep)
}
urb.waspDeps()
urb.waspAll = function(sel){
[].map.call(document.querySelectorAll(sel), urb.waspElem)
}
urb.waspAll('script'); urb.waspAll('link')
}

2
sur/down.hoon
View File

@ -3,5 +3,5 @@
::
/? 310
/- markdown
down.markdown
down:markdown

5
sur/gh.hoon
View File

@ -1,4 +1,4 @@
:: https:==developer.github.com/v3/
:: https://developer.github.com/v3/
::
:: These types correspond to the types that Github's API
:: produces, so please check Github's documentation for
@ -97,7 +97,8 @@
site-admin/?
==
++ issue
$: url/@t
$: raw/json
url/@t
labels-url/@t
comments-url/@t
events-url/@t