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

Merge remote-tracking branch 'origin/release-candidate' into lighter-than-eyre

Browse Source 
This also fixes up the changes in the vane interface. We can make
a pill with this and can boot it. We can even start the %server app
and ship down a single timer event to the browser, but subsequent
events have broken in the interim; debug on Monday.
This commit is contained in:
Elliot Glaysher 2018-12-14 16:04:13 -08:00
commit 2a0cc8a6aa
139 changed files with 26497 additions and 22705 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.travis/get-or-build-pill.sh
View File

@ -33,7 +33,9 @@ mkdir prev
|autoload |
|mount %
.
[ $? = 0 ] && cp -r ../sys prev/zod/home/
[ $? = 0 ] && cp -r ../sys prev/zod/home/ &&
cp ../gen/solid.hoon prev/zod/home/gen/ &&
cp ../lib/pill.hoon prev/zod/home/lib/
} || {
: Pilling: Parent-pill pier not available, trying preceding pill commit
HASH2=$(git -C .. log -2 $HASH --format=%H -- sys/ | tail -1)

2
.travis/pin-parent-pill-pier.url
View File

@ -1 +1 @@
https://ci-piers.urbit.org/zod-8a01c3a5f3b4a18684bb8ba8624cc02768b037a8.tgz
https://ci-piers.urbit.org/zod-5d1d390c917fa3e51760af40cf6eafb04ceae880.tgz

2
.travis/pin-vere-commit.txt
View File

@ -1 +1 @@
b93fccf82bcaee70c944c6b0deeec653201e9f28
65ce838b26f64311e73410512d83898b081873db

4
app/ask.hoon
View File

@ -94,7 +94,7 @@
(transmit set+~ pro+prompt ~) :: XX handle multiple links?
::
$det :: reject all input
=^ inv som (~(transceive ^sole som) +.act)
=^ inv som (~(transceive sole som) +.act)
=. sos (~(put by sos) ost.bow som)
?~ wom
=/ try (rose (tufa buf.som) fed:ag)
@ -125,7 +125,7 @@
++ transmit
|= {inv/sole-edit mor/(list sole-effect)}
=/ som (~(got by sos) ost.bow)
=^ det som (~(transmit ^sole som) inv)
=^ det som (~(transmit sole som) inv)
=. sos (~(put by sos) ost.bow som)
[[(effect mor+[det+det mor])]~ +>.$]
::

43
app/dojo.hoon
View File

@ -5,8 +5,6 @@
/- sole, lens :: console structures
/+ sole :: console library
=, sole
=, space:userlib
=, format
:: :: ::
:::: :: ::::
:: :: ::
@ -116,10 +114,10 @@
mark
{$hiss hiss:eyre}
==
[%build wire @p ? schematic:ford]
[%kill wire @p]
[%build wire ? schematic:ford]
[%kill wire ~]
{$deal wire sock term club} ::
{$info wire @p toro:clay} ::
{$info wire toro:clay} ::
== ::
++ move (pair bone card) :: user-level move
++ sign ::
@ -310,7 +308,7 @@
::
=? a &(?=(^ a) =('' i.a))
t.a
=+((de-beam a) ?^(- u [he-beak (flop a)]))
=+((de-beam:format a) ?^(- u [he-beak (flop a)]))
=+ vez=(vang | dp-path)
(sear plex:vez (stag %clsg poor:vez))
::
@ -320,11 +318,11 @@
auru:de-purl:html
::
++ dp-model ;~(plug dp-server dp-config) :: ++dojo-model
++ dp-path (en-beam he-beam) :: ++path
++ dp-path (en-beam:format he-beam) :: ++path
++ dp-server (stag 0 (most net sym)) :: ++dojo-server
++ dp-hoon tall:(vang | dp-path) :: ++hoon
++ dp-rood :: 'dir' hoon
=> (vang | (en-beam dir))
=> (vang | (en-beam:format dir))
;~ pose
rood
::
@ -365,7 +363,7 @@
?> ?=($~ pux)
:: pin all builds to :now.hid so they don't get cached forever
::
(he-card(poy `+>+<(pux `way)) %build way our.hid live=%.n schematic)
(he-card(poy `+>+<(pux `way)) %build way live=%.n schematic)
::
++ dy-eyre :: send work to eyre
|= {way/wire usr/(unit knot) req/hiss:eyre}
@ -378,7 +376,7 @@
=. poy ~
?~ pux +>
%. [%txt "! cancel {<u.pux>}"]
he-diff:(he-card [%kill u.pux our.hid])
he-diff:(he-card [%kill u.pux ~])
::
++ dy-slam :: call by ford
|= {way/wire gat/vase sam/vase}
@ -566,9 +564,9 @@
?: ?=({@ ~} pax) ~[i.pax %home '0']
?: ?=({@ @ ~} pax) ~[i.pax i.t.pax '0']
pax
=. dir (need (de-beam pax))
=. dir (need (de-beam:format pax))
=- +>(..dy (he-diff %tan - ~))
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam he-beak s.dir))]
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam:format he-beak s.dir))]
==
::
$help
@ -588,8 +586,7 @@
%- he-card(poy ~) :*
%info
/file
our.hid
(foal (en-beam p.p.mad) cay)
(foal:space:userlib (en-beam:format p.p.mad) cay)
==
::
$flat
@ -1269,10 +1266,10 @@
++ dy-edit :: handle edit
|= cal/sole-change
^+ +>+>
=^ dat say (~(transceive ^sole say) cal)
=^ dat say (~(transceive sole say) cal)
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-edit-busy
=^ lic say (~(transmit ^sole say) dat)
=^ lic say (~(transmit sole say) dat)
(dy-diff %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
::
@ -1541,12 +1538,12 @@
++ he-errd :: reject update
|= {rev/(unit sole-edit) err/@u} ^+ +>
=+ red=(fall rev [%nop ~]) :: required for error location sync
=^ lic say (~(transmit ^sole say) red)
=^ lic say (~(transmit sole say) red)
(he-diff %mor [%det lic] [%err err] ~)
::
++ he-pone :: clear prompt
^+ .
=^ cal say (~(transmit ^sole say) [%set ~])
=^ cal say (~(transmit sole say) [%set ~])
(he-diff %mor [%det cal] ~)
::
++ he-prow :: where we are
@ -1625,7 +1622,7 @@
(he-diff %tan u.p.cit)
::
++ he-lens
|= com/command:^^^^lens
|= com/command:^^lens
^+ +>
=+ ^- source/dojo-source
=| num/@
@ -1701,7 +1698,7 @@
?- -.sink.com
$stdout [%show %0]
$output-file $(sink.com [%command (cat 3 '@' pax.sink.com)])
$output-clay [%file (need (de-beam pax.sink.com))]
$output-clay [%file (need (de-beam:format pax.sink.com))]
$url [%http %post `~. url.sink.com]
$to-api !!
$send-api [%poke our.hid api.sink.com]
@ -1719,7 +1716,7 @@
^+ +>
:: ~& [%his-clock ler.cal]
:: ~& [%our-clock ven.say]
=^ dat say (~(transceive ^sole say) cal)
=^ dat say (~(transceive sole say) cal)
?. ?& ?=($del -.dat)
=(+(p.dat) (lent buf.say))
==
@ -1753,7 +1750,7 @@
?~ p.doy
(he-errd ~ (lent txt))
=+ old=(weld ?~(buf "> " " ") (tufa buf.say))
=^ cal say (~(transmit ^sole say) [%set ~])
=^ cal say (~(transmit sole say) [%set ~])
=. +>.$ (he-diff %mor txt+old nex+~ det+cal ~)
?- -.u.p.doy
%& (he-plan(buf ~) p.u.p.doy)
@ -1815,7 +1812,7 @@
(wrap he-type):arm
::
++ poke-lens-command
|= com/command:^^^^lens ~| poke-lens+com %. com
|= com/command:^^lens ~| poke-lens+com %. com
(wrap he-lens):arm
::
++ poke-json

329
app/gh.hoon
View File

@ -1,329 +0,0 @@
:: This is a connector for the Github API v3.
::
:: You can interact with this in a few different ways:
::
:: - .^({type} %gx /=gh={/endpoint}) to read data or
:: .^(arch %gy /=gh={/endpoint}) to explore the possible
:: endpoints.
::
:: - subscribe to /listen/{owner}/{repo}/{events...} for
:: webhook-powered event notifications. For event list, see
:: https://developer.github.com/webhooks/.
::
:: This is written with the standard structure for api
:: connectors, as described in lib/connector.hoon.
::
/? 314
/- gh, plan-acct
/+ gh-parse, connector
::
::
=, html
=, eyre
=> |%
++ 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 ~}
==
::
:: 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
::
=, gall
|_ $: hid/bowl
hook/(map @t {id/@t listeners/(set bone)}) :: map events to listeners
==
:: ++ prep _`. :: Clear state when code changes
::
:: List of endpoints
::
++ 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
==
==
::
:: 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:clay *} 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:clay @ *} 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
|%
++ abet :: Resolve core.
^- {(list move) _+>.$}
[(flop mow) +>.$]
::
++ send-hiss :: Send a hiss
|= hiz/hiss
^+ +>
=+ 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
^+ .
=+ 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)
::
:: Set up a webhook.
::
++ create-hook
|= event/@t
^+ +>
?> ?=({@ @ *} pax)
=+ clean-event=`tape`(turn (trip event) |=(a/@tD ?:(=('_' a) '-' a)))
=. hook
%+ ~(put by hook) (crip clean-event)
=+ %+ fall
(~(get by hook) (crip clean-event))
*{id/@t listeners/(set bone)}
[id (~(put in listeners) ost.hid)]
%- send-hiss
:* %+ scan
=+ [(trip i.pax) (trip i.t.pax)]
"https://api.github.com/repos/{-<}/{->}/hooks"
auri:de-purl
%post ~ ~
%- as-octt:mimes %- en-json %- pairs:enjs:format :~
name+s+%web
active+b+&
events+a+~[s+event] ::(turn `(list ,@t)`t.t.pax |=(a=@t s/a))
:- %config
%- pairs:enjs:format :~
=+ =+ clean-event
"http://107.170.195.5:8443/~/to/gh/gh-{-}.json?anon&wire=/"
[%url s+(crip -)]
[%'content_type' s+%json]
==
==
==
::
:: Add current bone to the list of subscribers for this event.
::
++ update-hook
|= event/@t
^+ +>
=+ hok=(~(got by hook) event)
%_ +>.$
hook
%+ ~(put by hook) event
hok(listeners (~(put in listeners.hok) ost.hid))
==
--
::
:: Pokes that aren't caught in more specific arms are handled
:: here. These should be only from webhooks firing, so if we
:: get any mark that we shouldn't get from a webhook, we reject
:: it. Otherwise, we spam out the event to everyone who's
:: listening for that event.
::
++ poke
|= response/hook-response
^- {(list move) _+>.$}
=+ hook-data=(~(get by hook) (rsh 3 3 -.response))
?~ hook-data
~& [%strange-hook hook response]
[~ +>.$]
:: ~& response=response
:_ +>.$
%+ turn ~(tap in listeners.u.hook-data)
|= ost/bone
[ost %diff response]
--

50
app/github.hoon
View File

@ -1,50 +0,0 @@
:: This is a command-line ui for the %gh Github driver.
::
:: Usage:
:: :github &path /read{/endpoint}
:: :github &path /listen/{owner}/{repo}/{events...}
::
/- gh
::
=> |%
++ diff-result
$% {$gh-issue issues:gh}
{$gh-issue-comment issue-comment:gh}
==
--
=, gall
|_ {hid/bowl *}
++ poke-path
|= pax/path
:_ +>.$ :_ ~
[ost.hid %peer /into-the-mist [our.hid %gh] scry+x+pax]
++ diff-gh-issues
|= {way/wire issues:gh}
%- %- slog :~
leaf+"in repository {(trip login.owner.repository)}/{(trip name.repository)}:"
leaf+"{(trip login.sender)} {(trip -.action)} issue #{<number.issue>} {<title.issue>}"
?+ -.action *tank
?($assigned $unassigned)
leaf+"to {(trip login.assignee.action)}"
?($labeled $unlabeled)
leaf+"with {(trip name.label.action)}"
==
==
[~ +>.$]
++ diff-gh-issue-comment
|= {way/wire issue-comment:gh}
%- %- slog :~
leaf+"in repository {(trip login.owner.repository)}/{(trip name.repository)}:"
leaf+"{(trip login.sender)} commented on issue #{<number.issue>} {<title.issue>}:"
leaf+(trip body.comment)
==
[~ +>.$]
++ diff-json
|= {way/wire jon/json}
~& jon
[~ +>.$]
++ peek
|= {ren/@tas tyl/path}
^- (unit (unit (pair mark *)))
``noun+[ren tyl]
--

51
app/hall.hoon
View File

@ -22,7 +22,6 @@
::
::::
=, hall-sur
=, hall-lib
=> :: #
:: # %arch
:: #
@ -100,7 +99,7 @@
== ::
++ card :: general card
$% {$diff lime} ::
{$info wire ship term nori:clay} ::
{$info wire term nori:clay} ::
{$peer wire dock path} ::
{$poke wire dock pear} ::
{$pull wire dock ~} ::
@ -117,7 +116,7 @@
:: #
:: functional cores and arms.
::
~% %hall-door ..^^^is ~
~% %hall-door ..is ~
|_ {bol/bowl:gall $1 state}
::
:: # %transition
@ -360,7 +359,7 @@
(ta-action [%create nom des typ])
%- ta-deltas
:: if needed, subscribe to our parent's /burden.
=+ sen=(above [our now our]:bol)
=+ sen=(above:hall-lib [our now our]:bol)
?: ?| !=(%czar (clan:title sen))
=(sen our.bol)
=(%pawn (clan:title our.bol))
@ -770,7 +769,7 @@
~/ %hall-ta-observe
|= who/ship
^+ +>
?. =(our.bol (above our.bol now.bol who))
?. =(our.bol (above:hall-lib our.bol now.bol who))
~&([%not-our-bearer who] +>)
(ta-delta %observe who)
::
@ -1145,7 +1144,7 @@
:: ignore if it won't result in change.
?. ?| &(?=($remove -.dif.rum) ?=(^ old))
?=(~ old)
!=(u.old (change-config u.old dif.rum))
!=(u.old (change-config:hall-lib u.old dif.rum))
==
+>.$
:: full changes to us need to get split up.
@ -1165,7 +1164,7 @@
:: ignore if it won't result in change.
?. ?| &(?=($remove -.dif.rum) ?=(^ old))
?=(~ old)
!=(u.old (change-status u.old dif.rum))
!=(u.old (change-status:hall-lib u.old dif.rum))
==
+>.$
(so-delta-our rum)
@ -1251,7 +1250,7 @@
:: in audience, replace above with us.
::TODO this really should be done by the sender.
=. aud.t
=+ dem=[(above [our now our]:bol) nom]
=+ dem=[(above:hall-lib [our now our]:bol) nom]
?. (~(has in aud.t) dem) aud.t
=+ (~(del in aud.t) dem)
(~(put in -) so-cir)
@ -1259,7 +1258,7 @@
?: &(?=(^ num) =(t (snag u.num grams))) ~
::TODO this really should have sent us the message
:: src as well but that's not an easy fix.
`[%story nom %gram [(above [our now our]:bol) nom] t]
`[%story nom %gram [(above:hall-lib [our now our]:bol) nom] t]
==
:: inherited flag
%_(self deltas [[%story nom %inherited &] deltas])
@ -1284,7 +1283,7 @@
?| !(~(has by locals) who)
::
=+ old=(~(got by locals) who)
=+ new=(change-status - dif)
=+ new=(change-status:hall-lib - dif)
?& !=(old new)
::
?= ~
@ -1940,7 +1939,7 @@
~/ %hall-da-change-nick
|= {who/ship nic/nick}
^+ +>
+>(nicks (change-nicks nicks who nic))
+>(nicks (change-nicks:hall-lib nicks who nic))
::
:: #
:: # %stories
@ -2126,7 +2125,7 @@
=. +>
%- sa-emil
(sa-config-effects shape dif.det)
+>(shape (change-config shape dif.det))
+>(shape (change-config:hall-lib shape dif.det))
::
$status
%_ +>
@ -2134,7 +2133,7 @@
?: ?=($remove -.dif.det)
(~(del by locals) who.det)
%+ ~(put by locals) who.det
%+ change-status
%+ change-status:hall-lib
(fall (~(get by locals) who.det) *status)
dif.det
==
@ -2197,7 +2196,7 @@
?: ?=($remove -.dif.det)
+>(mirrors (~(del by mirrors) cir.det))
=/ new/config
%+ change-config
%+ change-config:hall-lib
(fall (~(get by mirrors) cir.det) *config)
dif.det
+>.$(mirrors (~(put by mirrors) cir.det new))
@ -2209,7 +2208,7 @@
=+ ole=(fall (~(get by remotes) cir.det) *group)
?: ?=($remove -.dif.det) (~(del by ole) who.det)
=+ old=(fall (~(get by ole) who.det) *status)
(~(put by ole) who.det (change-status old dif.det))
(~(put by ole) who.det (change-status:hall-lib old dif.det))
==
==
::
@ -2342,7 +2341,7 @@
;: weld
/circle/[nom]/(scot %p hos.cir)/[nom.cir]
(sort wat gth) :: consistence
(range-to-path ran)
(range-to-path:hall-lib ran)
==
::
++ wire-to-peer
@ -2371,7 +2370,7 @@
(welp /circle t.t.t.wir)
::
{$burden *}
:- (above [our now our]:bol)
:- (above:hall-lib [our now our]:bol)
/burden/(scot %p our.bol)
::
{$report @ *}
@ -2395,7 +2394,7 @@
:^ %circle
i.t.wir
[(slav %p i.t.t.wir) i.t.t.t.wir]
(path-to-range t.t.t.t.wir)
(path-to-range:hall-lib t.t.t.t.wir)
::
{$repeat @ @ @ ~}
:+ %repeat
@ -2731,7 +2730,7 @@
::
$report
:: only send changes we didn't get from above.
?: =(src.bol (above [our now our]:bol)) ~
?: =(src.bol (above:hall-lib [our now our]:bol)) ~
:: only send story reports about grams and status.
?. ?=($story -.det) ~
?. ?=(?($gram $status) -.det.det) ~
@ -2740,7 +2739,7 @@
?. inherited.soy ~
:: only burden channels for now.
?. =(%channel sec.con.shape.soy) ~
`[%burden nom.det (dedicate (above [our now our]:bol) nom.det det.det)]
`[%burden nom.det (dedicate (above:hall-lib [our now our]:bol) nom.det det.det)]
::
$peers
?. ?=($story -.det) ~
@ -2826,7 +2825,7 @@
?~ pax qer
::TODO can probably do this a bit better...
?+ i.pax
qer(ran (path-to-range pax))
qer(ran (path-to-range:hall-lib pax))
::
circle-data %_ $ pax t.pax
wat.qer (~(put in wat.qer) i.pax)
@ -2863,7 +2862,7 @@
:: parse a list of coins into a query structure.
::
^- $-((list coin) query)
=> depa
=> depa:hall-lib
|^ %- af :~
[%client ul]
[%circles (at /[%p])]
@ -2890,10 +2889,10 @@
$circles =(who who.qer)
$public &
$burden ?& =(who who.qer)
=(our.bol (above our.bol now.bol who))
=(our.bol (above:hall-lib our.bol now.bol who))
==
$peers =(who our.bol) ::TODO or so-visible?
$report =(who (above [our now our]:bol))
$report =(who (above:hall-lib [our now our]:bol))
::
$circle
?. (~(has by stories) nom.qer) |
@ -3115,7 +3114,6 @@
:* ost.bol
%info
/jamfile
our.bol
(foal:space:userlib paf [%hall-telegrams !>(-)])
==
::
@ -3212,7 +3210,6 @@
:* ost.bol
%info
/jamfile
our.bol
(foal:space:userlib paf [%hall-telegrams !>(-)])
==
::
@ -3277,7 +3274,7 @@
?: =(a 'refederate')
~& 'refederating. may take a while...'
:_ +>
=+ bov=(above [our now our]:bol)
=+ bov=(above:hall-lib [our now our]:bol)
?: =(bov our.bol) ~
:~ [ost.bol %pull /burden [bov dap.bol] ~]
(wire-to-peer /burden)

1
app/hood.hoon
View File

@ -167,7 +167,6 @@
++ poke-helm-tlon-add-stream (wrap poke-tlon-add-stream):from-helm
++ poke-helm-tlon-init-stream (wrap poke-tlon-init-stream):from-helm
++ poke-hood-sync (wrap poke-sync):from-kiln
++ poke-hood-init-sync (wrap poke-init-sync):from-kiln
++ poke-kiln-commit (wrap poke-commit):from-kiln
++ poke-kiln-info (wrap poke-info):from-kiln
++ poke-kiln-label (wrap poke-label):from-kiln

78
app/mark-dashboard.hoon
View File

@ -1,78 +0,0 @@
|%
++ results (map mark (each vase tang))
++ show-results
=, format
|= a/results ^- json
:- %o
%- ~(run by a)
|= b/(each vase tang)
?- -.b
%& (tape:enjs (text p.b))
%| (tape:enjs (of-wall (wush 160 (flop p.b))))
==
++ wush
|= {wid/@u tan/tang} ^- wall
(zing (turn tan |=(a/tank (wash 0^wid a))))
--
::
=, gall
=, ford
|_ {bowl ~}
++ peek _~
++ peer-scry-x
|= path
[[ost %exec /all-marks our `build-marks]~ +>]
::
++ made-all-marks
|= {path @uvH a/gage}
:_ +>.$
?> ?=($tabl -.a)
=; res/results
[ost %diff [%json (show-results res)]]~
%- malt
%+ turn p.a
|= {k/gage v/gage} ^- {mark (each vase tang)}
:- ?>(?=({%& $mark * @tas} k) q.q.p.k)
?- -.v
$tabl !!
%& [%& q.p.v]
%| v
==
::
++ build-marks
^- {beak silk}
:- now-beak
:- %tabl
%+ turn (weld list-marks list-sub-marks)
|= {a/mark ~} ^- {silk silk}
:- [%$ %mark !>(a)]
[%bunt a]
::
++ poke-noun
|= *
~& have+list-marks
`+>
::
++ now-beak %_(byk r [%da now])
++ list-marks
=, space:userlib
=, format
=+ .^(arch %cy (en-beam now-beak /mar))
%+ skim ~(tap by dir)
|= {a/mark ~}
?=(^ (file (en-beam now-beak /hoon/[a]/mar)))
::
++ list-sub-marks
=, space:userlib
=, format
^- (list {mark ~})
%- zing ^- (list (list {mark ~}))
=/ top .^(arch %cy (en-beam now-beak /mar))
%+ turn ~(tap by dir.top)
|= {sub/knot ~}
=+ .^(arch %cy (en-beam now-beak /[sub]/mar))
%+ murn ~(tap by dir)
|= {a/mark ~} ^- (unit {mark ~})
?~ (file (en-beam now-beak /hoon/[a]/[sub]/mar)) ~
`[(rap 3 sub '-' a ~) ~]
--

93
app/pipe.hoon
View File

@ -1,93 +0,0 @@
/+ hall
::
=> |%
++ move (pair bone card)
++ card
$% {$peel wire dock mark path}
{$poke wire dock $hall-command command:hall}
==
--
::
=, gall
|_ {hid/bowl connections/(set {app/term source/path station/knot})}
++ poke-noun
|= arg/*
^- {(list move) _+>.$}
?: ?=($list arg)
(poke-pipe-list ~)
=+ ((soft {$cancel app/term source/path station/knot}) arg)
?^ -
(poke-pipe-cancel app.u source.u station.u)
=+ ((hard {app/term source/path station/knot}) arg)
(poke-pipe-connect app source station)
::
++ poke-pipe-list
|= ~
^- {(list move) _+>.$}
%- %- slog
%+ turn ~(tap in connections)
|= {app/term source/path station/knot}
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
[~ +>.$]
::
++ poke-pipe-cancel
|= {app/term source/path station/knot}
^- {(list move) _+>.$}
?. (~(has in connections) [app source station])
%- %- slog :~
leaf+"no connection:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$]
%- %- slog :~
leaf+"canceling:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$(connections (~(del in connections) [app source station]))]
::
++ poke-pipe-connect
|= {app/term source/path station/knot}
^- {(list move) _+>.$}
:_ +>.$(connections (~(put in connections) [app source station]))
:_ ~
~& [%peeling app source station]
:* ost.hid %peel [%subscribe app station source]
[our.hid app] %hall-speeches source
==
::
++ diff-hall-speeches
|= {way/wire speeches/(list speech:hall)}
^- {(list move) _+>.$}
?> ?=({$subscribe @ @ *} way)
=+ app=(slav %tas i.t.way)
=+ station=i.t.t.way
=+ source=t.t.t.way
?. (~(has in connections) [app source station])
%- %- slog :~
leaf+"pipe dropping:"
leaf+"{(trip app)}{<`path`source>} ---> {(trip station)}"
==
[~ +>.$]
:_ +>.$ :_ ~
:* ost.hid %poke [%relay app station source]
[our.hid %hall] %hall-command
%publish
|- ^- (list thought:hall)
?~ speeches
~
:_ $(speeches t.speeches, eny.hid (shax (cat 3 %pipe eny.hid)))
:* `@uvH`(end (sub 'H' 'A') 1 eny.hid)
[[[%& our.hid station] *envelope:hall %pending] ~ ~]
now.hid *(set flavor:hall) i.speeches
==
==
::
++ coup-relay
|= {way/wire saw/(unit tang)}
^- {(list move) _+>.$}
?> ?=({@ @ @ *} way)
?~ saw
[~ +>.$]
%- (slog leaf+"pipe relay failure in:" >way< u.saw)
[~ +>.$]
--

51
app/talk.hoon
View File

@ -13,15 +13,12 @@
:: since that's the only thing the client ever
:: subscribes to.
::
/- hall-sur=hall, sole-sur=sole :: structures
/+ hall-lib=hall, sole-lib=sole :: libraries
/- sole-sur=sole :: structures
/+ *hall, sole-lib=sole :: libraries
/= seed /~ !>(.)
::
::::
::
=, hall-sur
=, sole-sur
=, hall-lib
=> :: #
:: # %arch
:: #
@ -47,7 +44,7 @@
++ shell :: console session
$: id/bone :: identifier
latest/@ud :: latest shown msg num
say/sole-share :: console state
say/sole-share:sole-sur :: console state
active/audience :: active targets
settings/(set term) :: frontend settings
width/@ud :: display width
@ -55,7 +52,7 @@
== ::
++ move (pair bone card) :: all actions
++ lime :: diff fruit
$% {$sole-effect sole-effect} ::
$% {$sole-effect sole-effect:sole-sur} ::
== ::
++ pear :: poke fruit
$% {$hall-command command} ::
@ -330,7 +327,7 @@
:_ +>
:: seperate our sole-effects from other moves.
=/ yop
|- ^- (pair (list move) (list sole-effect))
|- ^- (pair (list move) (list sole-effect:sole-sur))
?~ moves [~ ~]
=+ mor=$(moves t.moves)
?: ?& =(id.cli p.i.moves)
@ -340,7 +337,7 @@
[[i.moves p.mor] q.mor]
:: flop moves, flop and squash sole-effects into a %mor.
=+ moz=(flop p.yop)
=/ foc/(unit sole-effect)
=/ foc/(unit sole-effect:sole-sur)
?~ q.yop ~
?~ t.q.yop `i.q.yop :: single sole-effect
`[%mor (flop q.yop)] :: more sole-effects
@ -590,7 +587,7 @@
++ ta-sole
:: apply sole input
::
|= act/sole-action
|= act/sole-action:sole-sur
^+ +>
?. =(id.cli ost.bol)
~&(%strange-sole !!)
@ -626,7 +623,7 @@
++ sh-fact
:: adds a console effect to ++ta's moves.
::
|= fec/sole-effect
|= fec/sole-effect:sole-sur
^+ +>
+>(moves [[id.she %diff %sole-effect fec] moves])
::
@ -655,7 +652,7 @@
++ sh-sole
:: applies sole action.
::
|= act/sole-action
|= act/sole-action:sole-sur
^+ +>
?- -.act
$det (sh-edit +.act)
@ -669,7 +666,7 @@
:: called when typing into the cli prompt.
:: applies the change and does sanitizing.
::
|= cal/sole-change
|= cal/sole-change:sole-sur
^+ +>
=^ inv say.she (~(transceive sole-lib say.she) cal)
=+ fix=(sh-sane inv buf.say.she)
@ -991,14 +988,14 @@
:: parses cli prompt input using ++sh-read and
:: sanitizes when invalid.
::
|= {inv/sole-edit buf/(list @c)}
^- {lit/(list sole-edit) err/(unit @u)}
|= {inv/sole-edit:sole-sur buf/(list @c)}
^- {lit/(list sole-edit:sole-sur) err/(unit @u)}
=+ res=(rose (tufa buf) sh-read)
?: ?=(%| -.res) [[inv]~ `p.res]
:_ ~
?~ p.res ~
=+ wok=u.p.res
|- ^- (list sole-edit)
|- ^- (list sole-edit:sole-sur)
?+ -.wok
~
::
@ -1009,11 +1006,11 @@
++ sh-slug
:: corrects invalid prompt input.
::
|= {lit/(list sole-edit) err/(unit @u)}
|= {lit/(list sole-edit:sole-sur) err/(unit @u)}
^+ +>
?~ lit +>
=^ lic say.she
(~(transmit sole-lib say.she) `sole-edit`?~(t.lit i.lit [%mor lit]))
(~(transmit sole-lib say.she) `sole-edit:sole-sur`?~(t.lit i.lit [%mor lit]))
(sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)])
::
++ sh-obey
@ -1374,7 +1371,7 @@
::
|= cis/(set circle) ^+ ..sh-work
=< (sh-fact %mor (murn (sort ~(tap by remotes) aor) .))
|= {cir/circle gop/group} ^- (unit sole-effect)
|= {cir/circle gop/group} ^- (unit sole-effect:sole-sur)
?. |(=(~ cis) (~(has in cis) cir)) ~
?: =(%mailbox sec.con:(fall (~(get by mirrors) cir) *config)) ~
?. (~(has in sources) cir) ~
@ -1407,14 +1404,14 @@
%+ sh-fact %mor
%- ~(rep by binds)
|= $: {gyf/char aus/(set audience)}
lis/(list sole-effect)
lis/(list sole-effect:sole-sur)
==
%+ weld lis
^- (list sole-effect)
^- (list sole-effect:sole-sur)
%- ~(rep in aus)
|= {a/audience l/(list sole-effect)}
|= {a/audience l/(list sole-effect:sole-sur)}
%+ weld l
^- (list sole-effect)
^- (list sole-effect:sole-sur)
[%txt [gyf ' ' ~(ar-phat ar a)]]~
::
++ number
@ -1466,7 +1463,7 @@
=- ~(tap in (~(del in src:-) [cir ~]))
(fall (~(get by mirrors) cir) *config)
|= s/^source
^- sole-effect
^- sole-effect:sole-sur
:- %txt
%+ weld ~(cr-phat cr cir.s)
%+ roll (range-to-path ran.s)
@ -2234,7 +2231,7 @@
:: produces sole-effect for printing message
:: details.
::
^- sole-effect
^- sole-effect:sole-sur
~[%mor [%tan tr-meta] tr-body]
::
++ tr-rend
@ -2306,7 +2303,7 @@
:: long-form display of message contents, specific
:: to each speech type.
::
|- ^- sole-effect
|- ^- sole-effect:sole-sur
?- -.sep
$lin
tan+~[leaf+"{?:(pat.sep "@ " "")}{(trip msg.sep)}"]
@ -2509,7 +2506,7 @@
++ poke-sole-action
:: incoming sole action. process it.
::
|= act/sole-action
|= act/sole-action:sole-sur
ta-done:(ta-sole:ta act)
::
::TODO for debug purposes. remove eventually.

32
app/test.hoon
View File

@ -69,8 +69,7 @@
|= [a=spur b=(list spur)]
~& >> (flop a)
:- %build
:^ a-core+a
our
:+ a-core+a
live=|
^- schematic:ford
:- [%core now-disc %hoon a]
@ -100,8 +99,7 @@
|= [a=term b=(list term)]
~& >> [%ren a]
:- %build
:^ a-rend+/[a]
our
:+ a-rend+/[a]
live=|
^- schematic:ford
=/ bem=beam (need (de-beam %/example))
@ -159,8 +157,6 @@
:- /ren/run "not meant to be called except on a (different) hoon file"
:- /ren/collections "temporarily disabled"
:- /ren/test-gen "temporarily disabled"
:- /ren/tree/index "temporarily disabled"
:- /ren/tree/elem "temporarily disabled"
:- /ren/urb "temporarily disabled"
:- /ren/x-urb "temporarily disabled"
:- /ren/x-htm "temporarily disabled"
@ -173,22 +169,6 @@
++ failing
^~ ^- (map path tape)
%- my :~ ::TODO don't hardcode
::
:- /app/pipe "wants 'flavor:hall' to exist"
:- /app/mark-dashboard "wants old ford"
:- /app/static "wants old ford"
:- /gen/capitalize "wants unicode-data/txt"
::
:- /app/twit "depends on sur/twitter"
:- /gen/twit/as "depends on sur/twitter"
:- /gen/twit/feed "depends on sur/twitter"
:- /mar/twit/cred "depends on sur/twitter"
:- /mar/twit/feed "depends on sur/twitter"
:- /mar/twit/post "depends on sur/twitter"
:- /mar/twit/req "depends on sur/twitter"
:- /mar/twit/usel "depends on sur/twitter"
:- /lib/twitter "depends on sur/twitter"
:- /sur/twitter "crashes with new type system"
::
:- /gen/al "compiler types out-of-date"
:- /gen/musk "compiler types out-of-date"
@ -196,13 +176,5 @@
:- /gen/cosmetic "incomplete"
:- /gen/lust "incomplete"
:- /gen/scantastic "incomplete"
::
:- /app/gh "crashes with new type system"
:- /mar/gh/issue-comment "wants old 'speech:hall'"
:- /mar/gh/issues "wants old 'speech:hall'"
::
:- /lib/down-jet "depends on lib/down-jet/parse"
:- /mar/down "depends on lib/down-jet/parse"
:- /lib/down-jet/parse "obsolete syntax"
==
--

5
app/test/example.md → app/test/example.udon
View File

@ -1,6 +1,5 @@
---
comments: true
---
:- ~[comments+&]
;>
# Static

319
app/twit.hoon
View File

@ -1,319 +0,0 @@
:: Twitter daemon
::
:::: /hoon/twit/app
::
/- plan-acct
/+ twitter, hall
::
:::: ~fyr
::
=, eyre
=, html
|%
++ twit-path :: valid peer path
$% {$cred ~} :: credential info
{$home p/@t ~} :: home timeline
{$user p/@t ~} :: user's tweets
{$post p/@taxuv ~} :: status of status
==
::
++ axle :: app state
$: $0
out/(map @uvI (each {knot cord} stat)) :: sent tweets
ran/(map path {p/@ud q/@da}) :: polls active
fed/(jar path stat) :: feed cache
ced/(unit (pair @da json)) :: credentials
==
::
++ gift :: subscription action
$% {$quit ~} :: terminate
{$diff gilt} :: send data
==
++ gilt
$% {$twit-feed p/(list stat)} :: posts in feed
{$twit-post p/stat} :: tweet accepted
{$ares term (list tank)} :: error
{$json json} :: unspecialized
==
::
++ move {bone card}
++ card :: arvo request
$? gift
$% {$hiss wire (unit user:eyre) api-call} :: api request
{$poke wire app-message} ::
{$wait wire p/@da} :: timeout
== ==
::
++ api-call {response-mark $twit-req {endpoint quay}} :: full hiss payload
++ response-mark ?($twit-post $twit-feed $twit-cred) :: sigh options
++ app-message
$? {{ship $hall} $hall-action action:hall} :: chat message
{{ship $hood} $write-plan-account user:eyre plan-acct} :: registration
== ::
++ sign :: arvo response
$% {$e $thou p/httr} :: HTTP result
{$t $wake ~} :: timeout ping
==
::
:: XX =*
++ stat post:twitter :: recieved tweet
++ command command:twitter :: incoming command
++ endpoint endpoint:reqs:twitter :: outgoing target
++ param param:reqs:twitter :: twit-req paramters
++ print print:twitter :: their serialization
::
--
::
::::
::
|_ {bowl:gall axle}
::
++ prep
|= a/(unit axle) ^- (quip move _+>)
?^ a [~ +>(+<+ u.a)]
(peer-scry-x /cred)
::
++ cull :: remove seen tweets
|= {pax/path rep/(list stat)} ^+ rep
=+ pev=(silt (turn (~(get ja fed) pax) |=(stat id)))
(skip rep |=(stat (~(has in pev) id)))
::
++ done [*(list move) .]
++ dely :: next polling timeout
|= pax/path
^- {(unit time) _ran}
=+ cur=(~(get by ran) pax)
=+ tym=(add now (mul ~s8 (bex ?~(cur 0 p.u.cur))))
:: ~& dely/`@dr`(sub tym now)
?: &(?=(^ cur) (gte tym q.u.cur) (gth q.u.cur now))
[~ ran]
[`tym (~(put by ran) pax ?~(cur 0 (min 5 +(p.u.cur))) tym)]
::
++ wait-new :: poll with min delay
|= {pax/path mof/(list move)}
(wait(ran (~(del by ran) pax)) pax mof)
::
++ wait :: ensure poll by path
|= {pax/path mof/(list move)} ^+ done
=^ tym ran (dely pax)
:_ +>.$
?~ tym
:: ~& no-wait/ran
mof
:: ~& will-wait/u.tym
:- [ost %wait pax u.tym]
mof
::
++ poke-twit-do :: recieve request
|= {usr/user:eyre act/command} ^+ done
?- -.act
$post
=. out (~(put by out) p.act %& usr q.act)
%+ wait-new /peer/home/[usr]
=+ req=[%twit-req `endpoint`update+[%status q.act]~ ~]
[ost %hiss post+(dray:wired ~[%uv] p.act) `usr %twit-post req]~
==
::
++ wake-peer
|= {pax/path ~} ^+ done
~& twit-wake+peer+pax
:_ +>.$
?. (~(has by ran) peer+pax) :: ignore if retracted
~
=+ => |=({a/bone @ b/path} [b a])
pus=(~(gas ju *(jug path bone)) (turn ~(tap by sup) .))
?~ (~(get ju pus) pax)
~
~& peer-again+[pax ran]
(pear | `~. pax) ::(user-from-path pax))
::
++ sigh-recoverable-error :: Rate-limit
|= {pax/path $429 $rate-limit lim/(unit @da)}
=. ran (~(put by ran) pax 6 now)
=+ tym=?~(lim (add ~m7.s30 now) (add ~1970.1.1 (mul ~s1 u.lim)))
~& retrying-in+`@dr`(sub tym now)
:_(+>.$ [ost %wait pax tym]~)
::
++ sigh-twit-cred-scry-cred sigh-twit-cred-cred :: alias
++ sigh-twit-cred-cred
|= {wir/wire acc/plan-acct raw/json} ^+ done
?> ?=(~ wir)
=+ pax=`twit-path`cred+wir
:_ +>.$(ced `[now raw])
:- [ost %poke pax [our %hood] %write-plan-account ~.twitter acc]
(spam-with-scry-x pax json+raw)
::
++ sigh-twit-post-post :: status acknowledged
|= {wir/wire rep/stat} ^+ done
=+ (raid:wired wir mez=%uv ~)
=. out (~(put by out) mez %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
:- (show-url [& ~ &+/com/twitter] `pax ~)
(spam-with-scry-x post+wir twit-post+rep)
::
++ sigh-twit-feed :: feed data
|= {wir/wire rep/(list stat)} ^+ done
?> ?=({?($peer $scry) *} wir)
=* pax t.wir
:: ~& got-feed+[(scag 5 (turn rep |=(stat id))) fed]
=+ ren=(cull pax rep) :: new messages
=. rep (weld ren (~(get ja fed) pax))
=. fed (~(put by fed) pax rep) :: save full list
?: ?=($scry -.wir)
[(spam scry+x+pax [%diff twit-feed+(flop rep)] [%quit ~] ~) +>.$]
?~ ren
(wait wir ~) :: pump polling
:: ~& spam-feed+ren
(wait-new wir (spam pax [%diff twit-feed+(flop ren)] ~))
::
++ sigh-tang :: Err
|= {pax/path tan/tang} ^+ done
~& sigh-tang+pax
%- (slog (flop tan))
=+ ^- git/gift
=+ err='' ::%.(q:(need r.hit) ;~(biff de-json mean:reparse:twitter)) :: XX parse?
:^ %diff %ares %bad-http
tan
:: [leaf/"HTTP Code {<p.hit>}" (turn (need err) mean:render:twit)]
?+ pax [[ost git]~ +>.$]
{$post @ ~}
[(spam pax git ~) +>.$]
==
::
:: ++ user-to-path |=(a/(unit iden) ?~(a '~' (scot %ta u.a)))
:: ++ user-from-path
:: |= pax/path ^- {(unit iden) path}
:: ~| %bad-user
:: ?~ pax ~|(%empty-path !!)
:: ~| i.pax
:: ?: =('~' i.pax) [~ t.pax]
:: [`(slav %ta i.pax) t.pax]
::
::
++ compat
|= {usr/(unit user:eyre) req/(unit user:eyre)}
?~(req & =(usr req))
::
:: /+ twitter
:: .^((list post:twitter) %gx /=twit=/home/urbit_test/twit-feed)
:: .^(post:twitter %gx /=twit=/post/0vv0old.0post.hash0.0000/twit-feed)
++ peek-x
|= pax/path ^- (unit (unit gilt))
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=+ gil=(pear-scry pax)
?- -.gil
$none ~
$part ~ :: stale data
$full ``p.gil
==
::
++ peer-scry-x
|= pax/path ^+ done
:_ +>
=+ pek=(peek-x pax)
?^ pek
?~ u.pek ~|(bad-scry+x+pax !!)
~[[ost %diff u.u.pek] [ost %quit ~]]
=+ usr=`~. :: =^ usr pax (user-from-path pax)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=+ hiz=(pear-hiss pax)
?~ hiz ~ :: already in flight
::?> (compat usr -.u.hiz) :: XX better auth
[ost %hiss scry+pax usr +.u.hiz]~
::
++ peer |=(pax/path :_(+> (pear & `~. pax))) :: accept subscription
++ pear :: poll, possibly returning current data
|= {ver/? usr/(unit user:eyre) pax/path}
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=+ gil=(pear-scry pax)
%+ welp
^- (list move)
?: ?=($full -.gil) ~ :: permanent result
=+ hiz=(pear-hiss pax)
?~ hiz ~
::?> (compat usr -.u.hiz) :: XX better auth
[ost %hiss peer+pax usr +.u.hiz]~
^- (list move)
?. ver ~
?- -.gil
$none ~
$part [ost %diff p.gil]~
$full ~[[ost %diff p.gil] [ost %quit ~]]
==
::
++ pear-scry
|= pax/twit-path ^- $%({$none ~} {$part p/gilt} {$full p/gilt})
?- -.pax
$post
=+ (raid:wired +.pax mez=%uv ~)
=+ sta=(~(get by out) mez)
?. ?=({~ %| *} sta)
[%none ~]
[%full twit-post+p.u.sta]
::
?($user $home)
[%part twit-feed+(flop (~(get ja fed) pax))]
::
$cred
?~ ced [%none ~]
?: (gth now (add p.u.ced ~m1)) :: stale
[%none ~]
[%full %json q.u.ced]
==
::
++ pear-hiss
|= pax/twit-path ^- (unit {(unit user:eyre) api-call})
?- -.pax
$post ~ :: future/unacked
$cred
`[`~. %twit-cred twit-req+[test-login+~ ['skip_status'^%t]~]]
::
$user
=+ ole=(~(get ja fed) pax)
=+ opt=?~(ole ~ ['since_id' (tid:print id.i.ole)]~)
`[`~. [%twit-feed twit-req+[posts-by+[(to-sd p.pax)]~ opt]]]
::
$home
=+ ole=(~(get ja fed) pax)
=+ opt=?~(ole ~ ['since_id' (tid:print id.i.ole)]~)
`[`p.pax [%twit-feed twit-req+[timeline+~ opt]]]
==
::
++ to-sd :: parse user name/numb
|= a/knot ^- sd:param
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:parse:twitter))
::
:: ++ pull :: release subscription
:: |= ost/bone
:: ?. (~(has by sup) ost) `+>.$ :: XX should not occur
:: =+ [his pax]=(~(got by sup) ost)
:: ?: (lth 1 ~(wyt in (~(get ju pus) pax)))
:: `+>.$
:: =: ran (~(del by ran) [%peer pax])
:: fed (~(del by fed) pax)
:: ==
:: `+>.$
::
++ spam-with-scry-x :: recieve final
|= {a/path b/gilt} ^- (list move)
=+ mof=~[[%diff b] [%quit ~]]
(weld (spam a mof) (spam scry+x+a mof))
::
++ spam :: send by path
|= {a/path b/(list gift)} ^- (list move)
%- zing ^- (list (list move))
%+ turn ~(tap by sup)
|= {ost/bone @ pax/path}
?. =(pax a) ~
(turn b |=(c/gift [ost c]))
::
++ show-url ~(said-url hall `bowl:gall`+<-)
--

130
gen/brass.hoon
View File

@ -2,6 +2,7 @@
:::: /hoon/brass/gen
::
/? 310
/+ pill
::
::::
!:
@ -73,7 +74,7 @@
state-gate
%= $
main-sequence +.main-sequence
state-gate .*(state-gate(+< -.main-sequence) -.state-gate)
state-gate .*(state-gate [%9 2 %10 [6 %1 -.main-sequence] %0 1])
==
::
:: boot-two: startup formula
@ -118,7 +119,7 @@
::
~> %slog.[0 leaf+"1-c (compiling compiler, wait a few minutes)"]
=+ ^= compiler-tool
.*(compiler-gate(+< [%noun compiler-source]) -.compiler-gate)
.*(compiler-gate [%9 2 %10 [6 %1 [%noun compiler-source]] %0 1])
::
:: switch to the second-generation compiler. we want to be
:: able to generate matching reflection nouns even if the
@ -136,13 +137,13 @@
::
~> %slog.[0 leaf+"1-e"]
=+ ^= kernel-span
-:.*(compiler-gate(+< [-.compiler-tool '+>']) -.compiler-gate)
-:.*(compiler-gate [%9 2 %10 [6 %1 [-.compiler-tool '+>']] %0 1])
::
:: compile the arvo source against the kernel core.
::
~> %slog.[0 leaf+"1-f"]
=+ ^= kernel-tool
.*(compiler-gate(+< [kernel-span arvo-source]) -.compiler-gate)
.*(compiler-gate [%9 2 %10 [6 %1 [kernel-span arvo-source]] %0 1])
::
:: create the arvo kernel, whose subject is the kernel core.
::
@ -159,15 +160,15 @@
::
:: compiler-twig: compiler as hoon expression
::
~& %metal-parsing
~& %brass-parsing
=+ compiler-twig=(ream compiler-source)
~& %metal-parsed
~& %brass-parsed
::
:: compiler-formula: compiler as nock formula
::
~& %metal-compiling
~& %brass-compiling
=+ compiler-formula=q:(~(mint ut %noun) %noun compiler-twig)
~& %metal-compiled
~& %brass-compiled
::
:: arvo-source: hoon source file producing arvo kernel, `sys/arvo`
::
@ -182,113 +183,8 @@
compiler-source
arvo-source
==
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
:: module-ova: vane load operations.
::
=+ ^= module-ova ^- (list ovum)
|^ :~ ::
:: sys/zuse: standard library
::
(vent %$ /zuse)
::
:: sys/vane/ames: network
::
(vent %a /vane/ames)
::
:: sys/vane/behn: timer
::
(vent %b /vane/behn)
::
:: sys/vane/clay: revision control
::
(vent %c /vane/clay)
::
:: sys/vane/dill: console
::
(vent %d /vane/dill)
::
:: sys/vane/eyre: web
::
(vent %e /vane/eyre)
::
:: sys/vane/ford: build
::
(vent %f /vane/ford)
::
:: sys/vane/gall: applications
::
(vent %g /vane/gall)
::
:: sys/vane/jael: security
::
(vent %j /vane/jael)
==
::
++ vent
|= {abr/term den/path}
=+ pax=(weld sys den)
=+ txt=.^(@ %cx (welp pax /hoon))
`ovum`[[%vane den] [%veer abr pax txt]]
--
::
:: file-ovum: userspace filesystem load
::
=+ ^= file-ovum ^- ovum
::
:: /app %gall applications
:: /gen :dojo generators
:: /lib %ford libraries
:: /mar %ford marks
:: /sur %ford structures
:: /ren %ford renderers
:: /web %eyre web content
:: /sys system files
:: /neo new system files
::
%. [/app /gen /lib /mar /neo /ren /sec /sur /sys /web ~]
|= :: sal: all spurs to load from
::
sal/(list spur)
^- ovum
::
:: hav: all user files
::
=; hav ~& user-files+(lent hav)
[[%$ %sync ~] [%into %$ & hav]]
=| hav/mode:clay
|- ^+ hav
?~ sal ~
=. hav $(sal t.sal)
::
:: tyl: spur
::
=/ tyl i.sal
|- ^+ hav
::
:: pax: full path at `tyl`
:: lon: directory at `tyl`
::
=/ pax (en-beam:format bec tyl)
=/ lon .^(arch %cy pax)
=? hav ?=(^ fil.lon)
?. ?=({$hoon *} tyl)
::
:: install only hoon files for now
::
hav
::
:: cot: file as plain-text octet-stream
::
=; cot [[(flop `path`tyl) `[/text/plain cot]] hav]
^- octs
?- tyl
{$hoon *}
=/ dat .^(@t %cx pax)
[(met 3 dat) dat]
==
=/ all ~(tap by dir.lon)
|- ^- mode:clay
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))
::
[boot-ova module-ova file-ovum]
:+ boot-ova
(module-ova:pill sys)
[(file-ovum:pill (en-beam:format bec /)) ~]

293
gen/capitalize.hoon
View File

@ -1,293 +0,0 @@
:: to use, download UnicdoeData.txt and place it in `%/lib/unicode-data/txt`.
::
::::
::
:: part 1: parse the file into {uppers}
::
/- unicode-data
/= case-table
/; !:
=>
|%
+$ case-fold
:: state that's part of the fold which generates the list of case-nodes
$: :: resulting data to pass to treeify.
out=(list case-node:unicode-data)
:: the start of a run of characters; ~ for not active.
start=(unit case-state)
:: previous character state
prev=case-state
==
::
+$ case-state
:: a temporary model which we compress later in a second pass.
$: point=@c
case=case-class
upper=case-offset:unicode-data
lower=case-offset:unicode-data
title=case-offset:unicode-data
==
::
+$ case-class
:: classification of an individual character.
$? $upper
$lower
$title
$none
$missing
==
--
|= a=(list line:unicode-data)
::
|^ %- build-tree
%- flop
(build-case-nodes a)
::
:: #
:: # %case-nodes
:: #
:: transforms raw unicode data into sequential case nodes.
+| %case-nodes
++ build-case-nodes
:: raw list of unicode data lines to a compact list of chardata
|= lines=(list line:unicode-data)
^- (list case-node:unicode-data)
::
:: todo: we don't have the final case range in the output of this
:: gate. this is because this algorithm doesn't work when the last
:: char is part of a range. this doesn't happen with the real one,
:: only the excerpts i was using for testing.
::
=< out
=| =case-fold
|- ^+ case-fold
?~ lines case-fold
::
=/ state=case-state (line-to-case-state i.lines)
::
?: (is-adjacent state prev.case-fold)
case-fold(prev state)
::
=. case-fold (add-range case-fold)
::
%_ case-fold
prev state
start ?.(?=(?(%missing %none) case.state) ~ `state)
==
::
++ line-to-case-state
:: creates an easy to merge form.
|= line:unicode-data
^- case-state
=/ out=case-state
[code %none [%none ~] [%none ~] [%none ~]]
?: =(code `@c`0)
=. case.out %missing
out
=. case.out
?+ gen %none
$lu %upper
$ll %lower
$lt %title
==
::
:: several characters aren't described as $lu or $ll but have lower or
:: upper state, such as u+2161. detect this and fix it up.
::
=? case.out &(=(case.out %none) !=(low ~)) %upper
=? case.out &(=(case.out %none) !=(up ~)) %lower
::
:: calculate offsets
::
=? upper.out !=(up ~) (calculate-offset (need up) code)
=? lower.out !=(low ~)
(calculate-offset (need low) code)
=? title.out !=(title ~) (calculate-offset (need title) code)
out
::
++ calculate-offset
|= [src=@c dst=@c]
^- case-offset:unicode-data
?: =(src dst)
[%none ~]
?: (gth src dst)
[%add (sub src dst)]
[%sub (sub dst src)]
::
++ is-adjacent
:: is {rhs} a continuation of {lhs}?
|= [lhs=case-state rhs=case-state]
^- ?
?: (lth point.rhs point.lhs)
$(lhs rhs, rhs lhs)
?: !=(point.rhs +(point.lhs))
%.n
?: !=(case.rhs case.lhs)
(upper-lower-adjacent lhs rhs)
?: =(case.lhs %none)
%.n
?: =(case.lhs %missing)
%.n
?: !=(upper.lhs upper.rhs)
%.n
?: !=(lower.lhs lower.rhs)
%.n
?: !=(title.lhs title.rhs)
%.n
%.y
::
++ upper-lower-adjacent
:: detects %upper-lower spans.
::
:: is {lhs} the same as {rhs}, but with opposite case?
|= [lhs=case-state rhs=case-state]
?: &(=(case.lhs %upper) !=(case.rhs %lower))
%.n
?: &(=(case.lhs %lower) !=(case.rhs %upper))
%.n
::
:: to simplify detection, if things are in the opposite order, redo
:: things flipped.
::
?: =(case.lhs %lower)
$(lhs rhs, rhs lhs)
?& (is-upper-lower lhs)
(is-lower-upper rhs)
==
::
++ is-upper-lower
|= i=case-state
=(+.+.i [[%none ~] [%add 1] [%none ~]])
::
++ is-lower-upper
|= i=case-state
=(+.+.i [[%sub 1] [%none ~] [%sub 1]])
::
++ is-none
|= i=case-state
=(+.+.i [[%none ~] [%none ~] [%none ~]])
::
++ add-range
|= c=case-fold
^+ c
?~ start.c
c
?: (is-none u.start.c)
c
?: ?& (gth point.prev.c point.u.start.c)
(is-upper-lower u.start.c)
==
=/ node=case-node:unicode-data
[`@ux`point.u.start.c `@ux`point.prev.c [%uplo ~] [%uplo ~] [%uplo ~]]
c(out [node out.c])
=/ node=case-node:unicode-data
[`@ux`point.u.start.c `@ux`point.prev.c +.+.u.start.c]
c(out [node out.c])
::
:: #
:: # %tree-building
:: #
:: builds a binary search tree out of the list
+| %tree-building
++ build-tree
|= a=(list case-node:unicode-data)
^- case-tree:unicode-data
:: there's probably a bottom up approach that doesn't require walking
:: a list over and over again.
::
:: use ?: instead of ?~ to prevent the TMI problem.
::
?: =(~ a)
~
=+ len=(lent a)
=/ split-at=@ (div len 2)
=/ lhs (scag split-at a)
=/ rhs (slag split-at a)
?~ rhs
?~ lhs
~
[i.lhs ~ ~]
=+ x=[i.rhs $(a lhs) $(a t.rhs)]
x
--
/: /===/lib/unicode-data /&unicode-data&/txt/
::
:: part 2: utility core
::
|%
++ transform
|= [a=tape fun=$-(@c @c)]
%- tufa
(turn (tuba a) fun)
::
++ to-upper
:: returns the uppercase of unicode codepoint {a}
|= a=@c
^- @c
:: special case ascii to not perform map lookup.
?: (lte a max-ascii)
?: &((gte a 'a') (lte a 'z'))
(sub a 32)
a
(apply-table a case-table %upper)
::
++ to-lower
:: returns the lowercase of unicode codepoint {a}
|= a=@c
^- @c
?: (lte a max-ascii)
?: &((gte a 'A') (lte a 'Z'))
(add 32 a)
a
(apply-table a case-table %lower)
::
++ apply-table
:: searches {table} and apples applies {type} to {a}.
::
:: this recursively walks the case tree {table}. if it finds an entry which
:: matches on {a}, it will apply the offset. otherwise, returns {a}.
|= [a=@c table=case-tree:unicode-data type=?($upper $lower $title)]
^- @c
?~ table
a
?: (lth a start.n.table)
$(table l.table)
?: (gth a end.n.table)
$(table r.table)
?. &((lte start.n.table a) (lte a end.n.table))
a
%^ apply-offset a type
?- type
$upper upper.n.table
$lower lower.n.table
$title title.n.table
==
::
++ apply-offset
:: applies an character offset to {a}.
|= [a=@c type=?($upper $lower $title) offset=case-offset:unicode-data]
^- @c
?- offset
{$add *} (add a a.offset)
{$sub *} (sub a s.offset)
{$none *} a
::
{$uplo *}
?- type
$upper (sub a 1)
$lower (add a 1)
$title (sub a 1)
==
==
::
++ max-ascii `@c`0x7f
--
::
:: part 3: generator
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[n=tape ~]
~
==
:- %tape (transform n to-upper)

1039
gen/cosmetic.hoon
View File

File diff suppressed because it is too large Load Diff

2
gen/hood/reboot.hoon
View File

@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ bec/beak}
{arg/~ ~}
==
[%helm-reload ~[%z %a %b %c %d %e %f %g %j]]
[%helm-reload ~[%z %a %b %c %d %f %g %j %l]]

66
gen/ivory.hoon
View File

@ -1,42 +1,74 @@
::
:::: /hoon/metal/gen
:::: /hoon/ivory/gen
::
/? 310
::
::::
!:
:- %say
|= $: {now/@da * bec/beak}
*
==
|= [[now=@da * bec=beak] *]
:- %noun
::
:: sys: root path to boot system, `/~me/[desk]/now/sys`
::
=+ sys=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
::
=/ sys=path
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
:: compiler-source: hoon source file producing compiler, `sys/hoon`
::
=+ compiler-source=.^(@t %cx (welp sys /hoon/hoon))
::
=/ compiler-source
.^(@t %cx (welp sys /hoon/hoon))
:: compiler-hoon: compiler as hoon expression
::
~& %ivory-parsing
=+ compiler-hoon=(ream compiler-source)
~& %ivory-parsed
:: Parsed with a static path for reproducibility.
::
~& %ivory-parsing
=/ compiler-hoon (rain /sys/hoon/hoon compiler-source)
~& %ivory-parsed
:: arvo-source: hoon source file producing arvo kernel, `sys/arvo`
::
=+ arvo-source=.^(@t %cx (welp sys /arvo/hoon))
::
=/ arvo-source
.^(@t %cx (welp sys /arvo/hoon))
:: whole-hoon: arvo within compiler
::
=+ whole-hoon=`hoon`[%tsbn compiler-hoon [%tsbn [%$ 7] (ream arvo-source)]]
:: Parsed with a static path for reproducibility.
::
=/ whole-hoon=hoon
:+ %tsbn compiler-hoon
:+ %tsld (rain /sys/arvo/hoon arvo-source)
[%$ 7]
:: compile the whole schmeer
::
~& %ivory-compiling
=+ whole-formula=q:(~(mint ut %noun) %noun whole-hoon)
=/ whole-formula
q:(~(mint ut %noun) %noun whole-hoon)
~& %ivory-compiled
:: zuse-ovo: standard library installation event
::
whole-formula
:: Arvo parses the %veer card contents with +rain;
:: we include a static path for reproducibility.
::
=/ zuse-ovo=ovum
:- /vane/zuse
[%veer %$ /sys/zuse/hoon .^(@ %cx (weld sys /zuse/hoon))]
:: installed: Arvo gate (formal instance) with %zuse installed
::
:: The :zuse-ovo event occurs at a defaulted date for reproducibility.
::
~& %zuse-installing
=/ installed
.* 0
:+ %7 whole-formula
[%9 2 %10 [6 %1 *@da zuse-ovo] %0 1]
~& %zuse-installed
:: our boot-ova is a list containing one massive formula:
::
:: We evaluate :whole-formula (for jet registration),
:: then ignore the result and produces :installed
::
=/ boot-ova=(list)
[[%7 whole-formula %1 installed] ~]
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
:: Our kernel event-list is ~, as we've already installed them.
:: Our userspace event-list is ~, as this pill must be compact.
::
[boot-ova ~ ~]

486
gen/lust.hoon
View File

@ -1,486 +0,0 @@
=> |%
::
++ system
$: rec/(map @ud theory)
say/theory
==
++ library
::
++ theory
$@ $? $void
$path
$noun
$hoon
$wall
$text
$tape
$cord
$null
$term
$type
$tank
==
$% {$list item/theory}
{$pole item/theory}
{$set item/theory}
{$map key/theory value/theory}
{$soft type/type data/theory}
{$tuple items/(list theory)}
{$label name/term data/theory}
{$tree item/theory}
{$help writ/writ theory/theory}
{$gate from/theory to/theory}
:: {$core library/}
{$unit item/theory}
{$atom aura/aura}
{$choice cases/(list theory)}
{$branch atom/theory cell/theory}
{$bridge double/theory single/theory}
{$switch cases/(list {stem/theory bulb/theory})}
{$constant aura/aura value/@}
{$pair p/theory q/theory}
{$trel p/theory q/theory r/theory}
{$qual p/theory q/theory r/theory s/theory}
{$quil p/theory q/theory r/theory s/theory t/theory}
--
|%
++ py
++ us :: prettyprinter
=> |%
++ cape {p/(map @ud wine) q/wine} ::
++ wine ::
$@ $? $noun ::
$path ::
$type ::
$void ::
$wall ::
$wool ::
$yarn ::
== ::
$% {$mato p/term} ::
{$core p/(list @ta) q/wine} ::
{$face p/term q/wine} ::
{$list p/term q/wine} ::
{$pear p/term q/@} ::
{$bcwt p/(list wine)} ::
{$plot p/(list wine)} ::
{$stop p/@ud} ::
{$tree p/term q/wine} ::
{$unit p/term q/wine} ::
== ::
--
|_ sut/type
++ dash
|= {mil/tape lim/char} ^- tape
:- lim
|- ^- tape
?~ mil [lim ~]
?: =(lim i.mil) ['\\' i.mil $(mil t.mil)]
?: =('\\' i.mil) ['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil) [i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 1 i.mil)) ~(x ne (end 2 1 i.mil)) $(mil t.mil)]
::
++ deal |=(lum/* (dish dole lum))
++ dial
|= ham/cape
=+ gid=*(set @ud)
=< `tank`-:$
|%
++ many
|= haz/(list wine)
^- {(list tank) (set @ud)}
?~ haz [~ gid]
=^ mor gid $(haz t.haz)
=^ dis gid ^$(q.ham i.haz)
[[dis mor] gid]
::
++ $
^- {tank (set @ud)}
?- q.ham
$noun :_(gid [%leaf '*' ~])
$path :_(gid [%leaf '/' ~])
$type :_(gid [%leaf '#' 't' ~])
$void :_(gid [%leaf '#' '!' ~])
$wool :_(gid [%leaf '*' '"' '"' ~])
$wall :_(gid [%leaf '*' '\'' '\'' ~])
$yarn :_(gid [%leaf '"' '"' ~])
{$mato *} :_(gid [%leaf '@' (trip p.q.ham)])
{$core *}
=^ cox gid $(q.ham q.q.ham)
:_ gid
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham [cox ~]
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
::
{$face *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%palm [['/' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
::
{$list *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
{$bcwt *}
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
::
{$plot *}
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['{' ~] ['}' ~]] coz])
::
{$pear *}
:_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
::
{$stop *}
=+ num=~(rend co [%$ %ud p.q.ham])
?: (~(has in gid) p.q.ham)
:_(gid [%leaf '#' num])
=^ cox gid
%= $
gid (~(put in gid) p.q.ham)
q.ham (~(got by p.ham) p.q.ham)
==
:_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
::
{$tree *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
{$unit *}
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
==
--
::
++ dish
|= {ham/cape lum/*} ^- tank
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
~| [%lump lum]
~| [%ham ham]
%- need
=| gil/(set {@ud *})
|- ^- (unit tank)
?- q.ham
$noun
%= $
q.ham
?: ?=(@ lum)
[%mato %$]
:- %plot
|- ^- (list wine)
[%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
==
::
$path
:- ~
:+ %rose
[['/' ~] ['/' ~] ~]
|- ^- (list tank)
?~ lum ~
?@ lum !!
?> ?=(@ -.lum)
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
::
$type
=+ tyr=|.((dial dole))
=+ vol=tyr(sut lum)
=+ cis=((hard tank) .*(vol -:vol))
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
$wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[[%leaf (trip ((hard @) -.lum))] $(lum +.lum)]
::
$wool
:- ~
:+ %rose
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
::
$yarn
[~ %leaf (dash (tape lum) '"')]
::
$void
~
::
{$mato *}
?. ?=(@ lum)
~
:+ ~
%leaf
?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
~(rend co [%$ p.q.ham lum])
$$ ~(rend co [%$ %ud lum])
$t (dash (rip 3 lum) '\'')
$tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
==
::
{$core *}
:: XX needs rethinking for core metal
:: ?. ?=(^ lum) ~
:: => .(lum `*`lum)
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
:: ^= tok
:: |- ^- (unit (list tank))
:: ?~ p.q.ham
:: =+ den=^$(q.ham q.q.ham)
:: ?~(den ~ [~ u.den ~])
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
[~ (dial ham)]
::
{$face *}
=+ wal=$(q.ham q.q.ham)
?~ wal
~
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
::
{$list *}
?: =(~ lum)
[~ %leaf '~' ~]
=- ?~ tok
~
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?: ?=(@ lum)
?.(=(~ lum) ~ [~ ~])
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
?. &(?=(^ for) ?=(^ aft))
~
[~ u.for u.aft]
::
{$bcwt *}
|- ^- (unit tank)
?~ p.q.ham
~
=+ wal=^$(q.ham i.p.q.ham)
?~ wal
$(p.q.ham t.p.q.ham)
wal
::
{$plot *}
=- ?~ tok
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?~ p.q.ham
~
?: ?=({* ~} p.q.ham)
=+ wal=^$(q.ham i.p.q.ham)
?~(wal ~ [~ [u.wal ~]])
?@ lum
~
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
?~ gim
~
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
?~ myd
~
[~ u.gim u.myd]
::
{$pear *}
?. =(lum q.q.ham)
~
=. p.q.ham
(rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
=+ fox=$(q.ham [%mato p.q.ham])
?> ?=({~ $leaf ^} fox)
?: ?=(?($n $tas) p.q.ham)
fox
[~ %leaf '%' p.u.fox]
::
{$stop *}
?: (~(has in gil) [p.q.ham lum]) ~
=+ kep=(~(get by p.ham) p.q.ham)
?~ kep
~|([%stop-loss p.q.ham] !!)
$(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
::
{$tree *}
=- ?~ tok
~
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
^= tok
=+ tuk=*(list tank)
|- ^- (unit (list tank))
?: =(~ lum)
[~ tuk]
?. ?=({n/* l/* r/*} lum)
~
=+ rol=$(lum r.lum)
?~ rol
~
=+ tim=^$(q.ham q.q.ham, lum n.lum)
?~ tim
~
$(lum l.lum, tuk [u.tim u.rol])
::
{$unit *}
?@ lum
?.(=(~ lum) ~ [~ %leaf '~' ~])
?. =(~ -.lum)
~
=+ wal=$(q.ham q.q.ham, lum +.lum)
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
==
::
++ doge
|= ham/cape
=- ?+ woz woz
{$list * {$mato $'ta'}} %path
{$list * {$mato $'t'}} %wall
{$list * {$mato $'tD'}} %yarn
{$list * $yarn} %wool
==
^= woz
^- wine
?. ?=({$stop *} q.ham)
?: ?& ?= {$bcwt {$pear $n $0} {$plot {$pear $n $0} {$face *} ~} ~}
q.ham
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
==
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
q.ham
=+ may=(~(get by p.ham) p.q.ham)
?~ may
q.ham
=+ nul=[%pear %n 0]
?. ?& ?=({$bcwt *} u.may)
?=({* * ~} p.u.may)
|(=(nul i.p.u.may) =(nul i.t.p.u.may))
==
q.ham
=+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
?: ?& ?=({$plot {$face *} {$face * $stop *} ~} din)
=(p.q.ham p.q.i.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
==
:+ %list
(cat 3 p.i.p.din p.i.t.p.din)
q.i.p.din
?: ?& ?= $: $plot
{$face *}
{$face * $stop *}
{{$face * $stop *} ~}
==
din
=(p.q.ham p.q.i.t.p.din)
=(p.q.ham p.q.i.t.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
=(1 (met 3 p.i.t.t.p.din))
==
:+ %tree
%^ cat
3
p.i.p.din
(cat 3 p.i.t.p.din p.i.t.t.p.din)
q.i.p.din
q.ham
::
++ dole
^- cape
=+ gil=*(set type)
=+ dex=[p=*(map type @) q=*(map @ wine)]
=< [q.p q]
|- ^- {p/{p/(map type @) q/(map @ wine)} q/wine}
=- [p.tez (doge q.p.tez q.tez)]
^= tez
^- {p/{p/(map type @) q/(map @ wine)} q/wine}
?: (~(meet ut sut) -:!>(*type))
[dex %type]
?- sut
$noun [dex sut]
$void [dex sut]
{$atom *} [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
{$cell *}
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
:- %plot
?:(?=({$plot *} q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
::
{$core *}
=+ yad=$(sut p.sut)
:- p.yad
=+ ^= doy ^- {p/(list @ta) q/wine}
?: ?=({$core *} q.yad)
[p.q.yad q.q.yad]
[~ q.yad]
:- %core
:_ q.doy
:_ p.doy
%^ cat 3
%~ rent co
:+ %$ %ud
%- ~(rep by (~(run by q.s.q.sut) |=(tomb ~(wyt by q))))
|=([[@ a=@u] b=@u] (add a b))
==
%^ cat 3
?-(p.q.sut $gold '.', $iron '|', $lead '?', $zinc '&')
=+ gum=(mug q.s.q.sut)
%+ can 3
:~ [1 (add 'a' (mod gum 26))]
[1 (add 'a' (mod (div gum 26) 26))]
[1 (add 'a' (mod (div gum 676) 26))]
==
::
{$help *}
$(sut q.sut)
::
{$face *}
=+ yad=$(sut q.sut)
?^(q.p.sut yad [p.yad [%face q.p.sut q.yad]])
::
{$fork *}
=+ yed=~(tap in p.sut)
=- [p [%bcwt q]]
|- ^- {p/{p/(map type @) q/(map @ wine)} q/(list wine)}
?~ yed
[dex ~]
=+ mor=$(yed t.yed)
=+ dis=^$(dex p.mor, sut i.yed)
[p.dis q.dis q.mor]
::
{$hold *}
=+ hey=(~(get by p.dex) sut)
?^ hey
[dex [%stop u.hey]]
?: (~(has in gil) sut)
=+ dyr=+(~(wyt by p.dex))
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
=+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
=+ rey=(~(get by p.p.rom) sut)
?~ rey
rom
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
==
::
++ duck (dial dole)
--

8
gen/metal.hoon
View File

@ -73,7 +73,7 @@
state-gate
%= $
main-sequence +.main-sequence
state-gate .*(state-gate(+< -.main-sequence) -.state-gate)
state-gate .*(state-gate [%9 2 %10 [6 %1 -.main-sequence] %0 1])
==
::
:: boot-two: startup formula
@ -118,7 +118,7 @@
::
~> %slog.[0 leaf+"1-c"]
=+ ^= compiler-tool
.*(compiler-gate(+< [%noun compiler-source]) -.compiler-gate)
.*(compiler-gate [%9 2 %10 [6 %1 [%noun compiler-source]] %0 1])
::
:: switch to the second-generation compiler. we want to be
:: able to generate matching reflection nouns even if the
@ -136,13 +136,13 @@
::
~> %slog.[0 leaf+"1-e"]
=+ ^= kernel-span
-:.*(compiler-gate(+< [-.compiler-tool '+>']) -.compiler-gate)
-:.*(compiler-gate [%9 2 %10 [6 %1 [-.compiler-tool '+>']] %0 1])
::
:: compile the arvo source against the kernel core.
::
~> %slog.[0 leaf+"1-f"]
=+ ^= kernel-tool
.*(compiler-gate(+< [kernel-span arvo-source]) -.compiler-gate)
.*(compiler-gate [%9 2 %10 [6 %1 [kernel-span arvo-source]] %0 1])
::
:: create the arvo kernel, whose subject is the kernel core.
::

366
gen/musk.hoon
View File

@ -1,366 +0,0 @@
::
::::
::
:- %say
|= {^ {{typ/type gen/hoon ~} ~}}
=< :- %noun
=+ pro=(~(mint ut typ) %noun gen)
~_ (~(dunk ut typ) 'blow-subject')
=+ bus=(bran:musk typ)
~& [%subject-mask mask.bus]
=+ jon=(apex:musk bus q.pro)
?~ jon
~& %constant-stopped
!!
?. ?=(%& -.u.jon)
~& %constant-blocked
!!
:: [p.pro [%1 p.u.jon]]
p.u.jon
|%
++ musk :: nock with block set
=> |%
++ block
:: identity of resource awaited
:: XX parameterize
noun
::
++ result
:: internal interpreter result
::
$@(~ seminoun)
::
++ seminoun
:: partial noun; blocked subtrees are ~
::
{mask/stencil data/noun}
::
++ stencil
:: noun knowledge map
::
$% :: no; noun has partial block substructure
::
{%| left/stencil rite/stencil}
:: yes; noun is either fully complete, or fully blocked
::
{%& blocks/(set block)}
==
::
++ output
:: nil; interpreter stopped
::
%- unit
:: yes, complete noun; no, list of blocks
::
(each noun (list block))
--
|%
++ bran
|= sut/type
=+ gil=*(set type)
|- ^- seminoun
?- sut
$noun [&+[~ ~ ~] ~]
$void [&+[~ ~ ~] ~]
{$atom *} ?~(q.sut [&+[~ ~ ~] ~] [&+~ u.q.sut])
{$cell *} (combine $(sut p.sut) $(sut q.sut))
{$core *} %+ combine:musk
?~ p.s.q.sut [&+[~ ~ ~] ~]
[&+~ p.s.q.sut]
$(sut p.sut)
{$face *} $(sut ~(repo ut sut))
{$fork *} [&+[~ ~ ~] ~]
{$help *} $(sut ~(repo ut sut))
{$hold *} ?: (~(has in gil) sut)
[&+[~ ~ ~] ~]
$(sut ~(repo ut sut), gil (~(put in gil) sut))
==
++ abet
:: simplify raw result
::
|= $: :: noy: raw result
::
noy/result
==
^- output
:: propagate stop
::
?~ noy ~
:- ~
:: merge all blocking sets
::
=/ blocks (squash mask.noy)
?: =(~ blocks)
:: no blocks, data is complete
::
&+data.noy
:: reduce block set to block list
::
|+~(tap in blocks)
::
++ apex
:: execute nock on partial subject
::
|= $: :: bus: subject, a partial noun
:: fol: formula, a complete noun
::
bus/seminoun
fol/noun
==
^- output
:: simplify result
::
%- abet
:: interpreter loop
::
|- ^- result
:: ~& [%apex-fol fol]
:: ~& [%apex-mac mask.bus]
:: =- ~& [%apex-pro-mac ?@(foo ~ ~!(foo mask.foo))]
:: foo
:: ^= foo
:: ^- result
?@ fol
:: bad formula, stop
::
~
?: ?=(^ -.fol)
:: hed: interpret head
::
=+ hed=$(fol -.fol)
:: propagate stop
::
?~ hed ~
:: tal: interpret tail
::
=+ tal=$(fol +.fol)
:: propagate stop
::
?~ tal ~
:: combine
::
(combine hed tal)
?+ fol
:: bad formula; stop
::
~
:: 0; fragment
::
{$0 b/@}
:: if bad axis, stop
::
?: =(0 b.fol) ~
:: reduce to fragment
::
(fragment b.fol bus)
::
:: 1; constant
::
{$1 b/*}
:: constant is complete
::
[&+~ b.fol]
::
:: 2; recursion
::
{$2 b/* c/*}
:: require complete formula
::
%+ require
:: compute formula with current subject
::
$(fol c.fol)
|= :: ryf: next formula
::
ryf/noun
:: lub: next subject
::
=+ lub=^$(fol b.fol)
:: propagate stop
::
?~ lub ~
:: recurse
::
^$(fol ryf, bus lub)
::
:: 3; probe
::
{$3 b/*}
%+ require
$(fol b.fol)
|= :: fig: probe input
::
fig/noun
:: yes if cell, no if atom
::
[&+~ .?(fig)]
::
:: 4; increment
::
{$4 b/*}
%+ require
$(fol b.fol)
|= :: fig: increment input
::
fig/noun
:: stop for cells, increment for atoms
::
?^(fig ~ [&+~ +(fig)])
::
:: 5; compare
::
{$5 b/*}
%+ require
$(fol b.fol)
|= :: fig: operator input
::
fig/noun
:: stop for atoms, compare cells
::
?@(fig ~ [&+~ =(-.fig +.fig)])
::
:: 6; if-then-else
::
{$6 b/* c/* d/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [2 [0 1] 2 [1 c d] [1 0] 2 [1 2 3] [1 0] 4 4 b]))
::
:: 7; composition
::
{$7 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [2 b 1 c]))
::
:: 8; declaration
::
{$8 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [7 [[7 [0 1] b] 0 1] c]))
::
:: 9; invocation
::
{$9 b/* c/*}
:: use standard macro expansion (slow)
::
$(fol =>(fol [7 c 2 [0 1] 0 b]))
::
:: 10; static hint
::
{$10 @ c/*}
:: ignore hint
::
$(fol c.fol)
::
:: 10; dynamic hint
::
{$10 {b/* c/*} d/*}
:: noy: dynamic hint
::
=+ noy=$(fol c.fol)
:: propagate stop
::
?~ noy ~
:: otherwise, ignore hint
::
$(fol d.fol)
==
::
++ combine
:: combine a pair of seminouns
::
|= $: :: hed: head of pair
:: tal: tail of pair
::
hed/seminoun
tal/seminoun
==
^- seminoun
?. ?& &(?=(%& -.mask.hed) ?=(%& -.mask.tal))
=(=(~ blocks.mask.hed) =(~ blocks.mask.tal))
==
:: default merge
::
[|+[mask.hed mask.tal] [data.hed data.tal]]
:: both sides total
::
?: =(~ blocks.mask.hed)
:: both sides are complete
::
[&+~ data.hed data.tal]
:: both sides are blocked
::
[&+(~(uni in blocks.mask.hed) blocks.mask.tal) ~]
::
++ fragment
:: seek to an axis in a seminoun
::
|= $: :: axe: tree address of subtree
:: bus: partial noun
::
axe/axis
bus/seminoun
==
|- ^- result
:: 1 is the root
::
?: =(1 axe) bus
:: now: 2 or 3, top of axis
:: lat: rest of axis
::
=+ [now=(cap axe) lat=(mas axe)]
?- -.mask.bus
:: subject is fully blocked or complete
::
%& :: if fully blocked, produce self
::
?^ blocks.mask.bus bus
:: descending into atom, stop
::
?@ data.bus ~
:: descend into complete cell
::
$(axe lat, bus [&+~ ?:(=(2 now) -.data.bus +.data.bus)])
:: subject is partly blocked
::
%| :: descend into partial cell
::
%= $
axe lat
bus ?: =(2 now)
[left.mask.bus -.data.bus]
[rite.mask.bus +.data.bus]
== ==
:: require complete intermediate step
::
++ require
|= $: noy/result
yen/$-(noun result)
==
^- result
:: propagate stop
::
?~ noy ~
:: if partial block, squash blocks and stop
::
?: ?=(%| -.mask.noy) [&+(squash mask.noy) ~]
:: if full block, propagate block
::
?: ?=(^ blocks.mask.noy) [mask.noy ~]
:: otherwise use complete noun
::
(yen data.noy)
::
++ squash
:: convert stencil to block set
::
|= tyn/stencil
^- (set block)
?- -.tyn
%& blocks.tyn
%| (~(uni in $(tyn left.tyn)) $(tyn rite.tyn))
==
--
--

194
gen/p2.hoon
View File

@ -1,194 +0,0 @@
/? 310
::
/+ pprint
::
!:
::
:- %say
::
=< |= {^ {{=arg ~} ~}}
^- [%txt wain]
::
=/ v=vase
?- target.arg
^ target.arg
%all !>(all-examples)
%demo !>(demo-example)
%test !>(test-example)
%type !>(type-example)
%xml !>(xml-example)
%kernel !>(xray-the-kernel-example)
%parser !>(xray-the-parser-example)
==
::
:- %txt
?- print.arg
%type (render-type:pprint p.v)
%val (render-vase:pprint v)
%both (render-vase-with-type:pprint v)
==
::
|%
::
+$ arg
$: print=?(%type %val %both)
target=$@(?(%all %demo %test %type %xml %kernel %parser) vase)
==
::
+$ option $?(%a %b %c)
::
+$ junct $@(@ {@ cord})
::
+$ union $%([%list (list ~)] [%unit (unit ~)])
::
+$ conjunct $^ [[@ @] cord]
[@ cord]
::
+$ misjunct $^([~ @] [cord @])
::
++ forks-example
:* :- %junct ^- (list junct) ~[3 [4 '5']]
:- %conjunct ^- (list conjunct) ~[[3 '4'] [[5 6] '7']]
:- %union ^- (list union) ~[[%list [~ ~]] [%unit [~ ~]]]
:- %option ^- (list option) ~[%a %a %b %c]
:- %misjunct ^- (list misjunct) ~[[~ 3] [~ 4]]
%nice
==
::
++ all-examples
:*
:- %type type-example
:- %cores core-example
:- %add ..add
:- zuse-example
:- %demo demo-example
:- %forks forks-example
%eof
==
::
++ type-example
^- type
-:!>(`(map ? (unit (list cord)))`~)
::
++ xray-the-parser-example
=> ..musk
|% ++ x ~ --
::
++ xray-the-kernel-example
|% ++ x ~ --
::
++ zuse-example
[%zuse ..zuse]
::
++ cores-example
|^ :*
[%trivial trivial-core-example]
[%gate gate-example]
[%core core-example]
==
::
--
::
++ trivial-core-example
=> ~
|% ++ x 3 --
::
++ core-example
=> [=gate-example]
|%
++ dup gate-example
++ const
|= x=* ^- $-(* *)
|= * ^- *
x
--
::
++ gate-example
=> ~
|= x=@ud
^- [@ud @ud]
[x x]
::
++ test-example
:*
`(list ?)`~[%.y %.n]
`(list ~)`~[~ ~]
`(unit ~)``~
/a/path
==
::
++ hoon-example
^- hoon
:+ %brcn ~
%- ~(gas by *(map term tome))
^- (list (pair term tome))
:_ ~
^- (pair term tome)
:- 'chapter'
^- tome
:- `what`~
%- ~(gas by *(map term hoon))
^- (list (pair term hoon))
:_ ~
:- 'arm'
:+ %brts `spec`[%bsts 'x' [%base [%atom ~.ud]]]
:- %clsg
~[[%wing ~['x']] [%$ 0]]
::
++ demo-example
:* [~ %.y %.n 1 0x2 ~ ~.knot 'cord' %const]
:* [%tape "a tape"]
[%path /path/literal `path`/typed/path]
[%unit `(unit @)`[~ 9]]
[%list [`?`%.y `(list ?)`~[%.y %.n %.y]]]
%nice
==
[%hoon hoon-example]
[%type -:!>(`(unit (list tape))`~)]
[%json-and-xml json-example xml-example]
%cool
==
::
++ xml-example
|^ ^- manx
:- ['json' ~]
:~ (json-to-xml json-example)
==
++ json-to-xml
|= j=json
^- manx
?- j
~ [['nil' ~] ~]
[%a *] [['array' ~] (turn p.j json-to-xml)]
[%b *] [['bool' ~[['' ?:(p.j "true" "false")]]] ~]
[%o *] [['obj' ~] (turn ~(tap by p.j) pair)]
[%n *] [['num' ~[[['n' 'val'] (trip p.j)]]] ~]
[%s *] [['str' ~[['' (trip p.j)]]] ~]
==
++ pair
|= [t=@t j=json]
^- manx
[['slot' ~[['key' (trip t)]]] ~[(json-to-xml j)]]
--
::
++ json-example
^- json
|^ ob2
++ nil ~
++ yes [%b %.y]
++ nah [%b %.n]
++ str [%s 'Very long test string. Test test test test test test test.']
++ foo 'foo'
++ bar 'bar'
++ baz 'baz'
++ one [%n '1']
++ ten [%n '10']
++ mil [%n '100000']
++ arr [%a ~[one ten mil]]
++ ar2 [%a ~[arr yes nah nil str]]
++ obj [%o (~(gas by *(map @t json)) ~[[foo mil] [baz arr]])]
++ ob2 [%o (~(gas by *(map @t json)) ~[[foo ar2] [bar obj] [baz yes]])]
++ ar3 [%a ~[arr obj ob2 one ten mil yes nah nil]]
--
::
--

6
gen/pipe/cancel.hoon
View File

@ -1,6 +0,0 @@
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{app/term source/path station/knot ~} ~}
==
[%pipe-cancel app source station]

6
gen/pipe/connect.hoon
View File

@ -1,6 +0,0 @@
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{app/term source/path station/knot ~} ~}
==
[%pipe-connect app source station]

6
gen/pipe/list.hoon
View File

@ -1,6 +0,0 @@
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{~ ~}
==
[%pipe-list ~]

124
gen/solid.hoon
View File

@ -6,62 +6,82 @@
:::: /hoon/solid/gen
::
/? 310
/+ pill
::
::::
!:
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{arg/$@(~ {top/path ~}) dub/_|}
|= $: [now=@da eny=@uvJ bec=beak]
arg=$@(~ [top=path ~])
dub=_|
==
?~ arg $(arg ~[top=`path`/(scot %p p.bec)/[q.bec]/(scot %da now)/sys])
::
:- %noun
=+ pax=`path`(weld top.arg `path`[%hoon ~])
=+ arp=`path`(weld top.arg `path`[%arvo ~])
~& %solid-start
=+ txt=.^(@t %cx (weld pax `path`[%hoon ~]))
=+ rax=.^(@t %cx (weld arp `path`[%hoon ~]))
=+ ^= ken
=- ?:(?=(%& -.res) p.res (mean (flop p.res)))
^= res %- mule |.
~& %solid-loaded
=+ gen=(rain pax txt)
~& %solid-parsed
=+ one=(~(mint ut %noun) %noun gen)
~& %solid-compiled
?. dub
=+ two=(~(mint ut p.one) %noun (rain arp rax))
~& %solid-arvo
[7 q.one q.two]
=+ zax=(cat 3 '=> ' (cat 3 txt (cat 3 ' ' rax)))
~& %solid-double-loading
=+ all=.*(0 q.one)
~& %solid-double-loaded
=< +
.*(all [9 2 [0 2] [1 %noun zax] [0 7]])
:: sys: root path to boot system, `/~me/[desk]/now/sys`
::
~& [%solid-kernel `@ux`(mug ken)]
:- ken
=+ all=.*(0 ken)
=+ ^= vay ^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%l /vane/light]
[%f /vane/ford]
[%b /vane/behn]
[%d /vane/dill]
[%a /vane/ames]
[%c /vane/clay]
[%g /vane/gall]
[%e /vane/eyre]
[%j /vane/jael]
==
|- ^+ all
?~ vay all
=+ pax=(weld top.arg q.i.vay)
=+ txt=.^(@ %cx (weld pax `path`[%hoon ~]))
=+ sam=[now `ovum`[[%gold ~] [%veer p.i.vay pax txt]]]
~& [%solid-veer i.vay]
=+ gat=.*(all .*(all [0 42]))
=+ nex=+:.*([-.gat [sam +>.gat]] -.gat)
$(vay t.vay, all nex)
=/ sys=path
?^ arg top.arg
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
::
=/ compiler-path (weld sys /hoon)
=/ arvo-path (weld sys /arvo)
~& %solid-start
=/ compiler-src .^(@t %cx (weld compiler-path /hoon))
=/ arvo-src .^(@t %cx (weld arvo-path /hoon))
=/ arvo-formula
~& %solid-loaded
=/ compiler-hoon (rain compiler-path compiler-src)
?. dub
:: compile arvo against hoon, with our current compiler
::
=/ whole-hoon=hoon
[%tsbn compiler-hoon [%tsbn [%$ 7] (rain arvo-path arvo-src)]]
~& %solid-parsed
=/ whole-formula q:(~(mint ut %noun) %noun whole-hoon)
~& %solid-arvo
whole-formula
:: compile arvo against hoon, with a freshly compiled hoon (via +ride)
::
~& %solid-parsed
=/ compiler-formula q:(~(mint ut %noun) %noun compiler-hoon)
~& %solid-compiled
=/ whole-src
(rap 3 ['=> ' compiler-src '=> +7 ' arvo-src ~])
~& %solid-double-loaded
=/ whole-formula
=< +
.* 0
:+ %7
compiler-formula
[%9 2 %10 [6 %1 %noun whole-src] [%0 1]]
~& %solid-double-compiled
whole-formula
::
~& [%solid-kernel `@ux`(mug arvo-formula)]
::
:: installed: Arvo gate (formal interface) with %zuse and vanes installed
::
=/ installed
=< q
%^ spin
(module-ova:pill sys)
.*(0 arvo-formula)
|= [ovo=ovum ken=*]
[~ (slum ken [now ovo])]
::
:: our boot-ova is a list containing one massive formula:
::
:: We evaluate :arvo-formula (for jet registration),
:: then ignore the result and produce :installed
::
=/ boot-ova=(list)
[[%7 arvo-formula %1 installed] ~]
::
:: a pill is a 3-tuple of event-lists: [boot kernel userspace]
::
:: Our kernel event-list is ~, as we've already installed them.
:: Our userspace event-list is a list containing a full %clay
:: filesystem sync event.
::
:+ boot-ova ~
=/ bas (flop (tail (flop sys)))
[(file-ovum:pill bas) ~]

14
gen/twit/as.hoon
View File

@ -1,14 +0,0 @@
:: Send tweet from an account
::
:::: /hoon/as/twit/gen
::
/- twitter
::
::::
::
=, twitter
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{who/knot msg/cord ~} ~}
==
[%twit-do [who %post `@uvI`(rsh 8 1 eny) msg]]

18
gen/twit/feed.hoon
View File

@ -1,18 +0,0 @@
:: Display twitter feed
::
:::: /hoon/feed/twit/gen
::
/? 310
/- twitter
::
:::: ~fyr
::
:- %say
|= $: {now/@da eny/@uvJ bek/beak}
{{who/iden ~} typ/?($user $home)}
==
=+ pax=/(scot %p p.bek)/twit/(scot %da now)/[typ]/[who]/twit-feed
:- %tang
%+ turn (flop .^((list post:twitter) %gx pax))
|= post:twitter ^- tank
rose+[": " `~]^~[leaf+"{<now>} @{(trip who)}" leaf+(trip txt)]

1442
lib/bip.hoon
View File

File diff suppressed because it is too large Load Diff

2
lib/bip32.hoon
View File

@ -81,7 +81,7 @@
++ derivation-path
;~ pfix
;~(pose (jest 'm/') (easy ~))
%+ most fas ::TODO net
%+ most net
;~ pose
%+ cook
|=(i=@ (add i (bex 31)))

46
lib/bip39.hoon Normal file
View File

@ -0,0 +1,46 @@
:: bip39 implementation in hoon
::
/+ bip39-english
::
|%
++ from-entropy
|= byts
^- tape
=. wid (mul wid 8)
~| [%unsupported-entropy-bit-length wid]
?> &((gte wid 128) (lte wid 256))
::
=+ cs=(div wid 32)
=/ check=@
%^ rsh 0 (sub 256 cs)
(sha-256l:sha (div wid 8) dat)
=/ bits=byts
:- (add wid cs)
%+ can 0
:~ cs^check
wid^dat
==
::
=/ pieces
|- ^- (list @)
:- (end 0 11 dat.bits)
?: (lte wid.bits 11) ~
$(bits [(sub wid.bits 11) (rsh 0 11 dat.bits)])
::
=/ words=(list tape)
%+ turn pieces
|= ind=@ud
(snag ind `(list tape)`bip39-english)
::
%+ roll (flop words)
|= [nex=tape all=tape]
?~ all nex
:(weld all " " nex)
::
::NOTE always produces a 512-bit result
++ to-seed
|= [mnem=tape pass=tape]
^- @
%- hmac-sha512t:pbkdf:crypto
[(crip mnem) (crip (weld "mnemonic" pass)) 2.048 64]
--

2052
lib/bip39/english.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

12
lib/collections.hoon
View File

@ -10,9 +10,9 @@
|%
+= move [bone card]
+= card
$% [%info wire ship toro:clay]
$% [%info wire toro:clay]
[%poke wire dock poke]
[%perm wire ship desk path rite:clay]
[%perm wire desk path rite:clay]
==
+= poke
$% [%hall-action action:hall]
@ -830,7 +830,7 @@
=/ bek byk.bol(r [%da now.bol])
=. pax (en-beam:format bek (flop pax))
%+ ta-emit ost.bol
[%info (weld /ta-write pax) our.bol (foal pax cay)]
[%info (weld /ta-write pax) (foal pax cay)]
::
++ ta-remove
=, space:userlib
@ -840,7 +840,7 @@
=. pax (en-beam:format bek (flop pax))
^+ ta-this
%+ ta-emit ost.bol
[%info (weld /ta-remove pax) our.bol (fray pax)]
[%info (weld /ta-remove pax) (fray pax)]
::
:: permissions
::
@ -849,14 +849,14 @@
|= [pax=path r=rule:clay w=rule:clay]
^+ ta-this
%+ ta-emit ost.bol
[%perm (weld /perms pax) our.bol q.byk.bol pax [%rw `r `w]]
[%perm (weld /perms pax) q.byk.bol pax [%rw `r `w]]
::
++ ta-flush-permissions
~/ %coll-ta-flush-permissions
|= pax=path
^+ ta-this
%+ ta-emit ost.bol
[%perm (weld /perms pax) our.bol q.byk.bol pax [%rw ~ ~]]
[%perm (weld /perms pax) q.byk.bol pax [%rw ~ ~]]
::
:: hall
::

17
lib/down-jet.hoon
View File

@ -1,17 +0,0 @@
::
:::: /hoon/down-jet/lib
::
/? 310
/+ *down-jet-parse, *down-jet-rend
::
::::
::
~% %down ..is ~
|%
++ mark
~/ %mark
|= p/@t
(normalize (rash p parse))
::
++ print sing
--

1
lib/down-jet/html5-entities.json
View File

File diff suppressed because one or more lines are too long

1009
lib/down-jet/parse.hoon
View File

File diff suppressed because it is too large Load Diff

249
lib/down-jet/rend.hoon
View File

@ -1,249 +0,0 @@
:: ++down rendering arms
::
:::: /hoon/rend/down-jet/lib
::
/? 310
/- *markdown
::
=, format
=, html
::
|%
++ into-inner
|= {a/marl b/manx}
?~ c.b b(c a)
$(b i.c.b)
::
++ flat
|= a/marl
^- tape
?~ a ~
%+ weld
^- tape
?~ n.g.i.a
?>(?=(_;/(**) i.a) v.i.a.g.i.a)
?+ n.g.i.a $(a c.i.a)
$img
%- zing ^- wall
%+ murn a.g.i.a |= {a/mane b/tape}
^- (unit tape)
?+ a ~
$alt [~ b]
==
==
$(a t.a)
::
++ sanitize
|= a/marl ^- tape
=- (zing `wall`(scan (flat a) fel))
=< fel=;~(sfix (star ;~(plug (cold '-' -) (plus +))) (star next))
[(star ;~(less aln prn)) ;~(pose nud low (cook |=(a/@ (add a ' ')) hig))]
::
++ sang :: tight item children
|= a/(list elem)
^- marl
?~ a ~
%+ weld
?. ?=($para -.i.a)
(sing i.a ~)
(sung p.i.a)
$(a t.a)
::
++ sing :: elem to manx
=, html
=> |%
++ first-word
|= a/tape
=. a (trip (crip a)) :: XX valid tapes
^- (unit tape)
=. a q.q:(need q:((star ace) [1 1] a))
=+ vex=((plus ;~(less ace prn)) [1 1] a)
?~ q.vex ~
(some (wonk vex))
--
=+ [tig=| had=*(unit mane)]
|= lum/(list elem)
|^ ^- marl
=+ a=apex
?~ q.a
p.a
(weld p.a $(lum q.a))
::
++ apex
^- {p/marl q/_lum}
?~ lum
?~ had [~ ~]
(lose "unclosed {<u.had>}")
=> [ele=i.lum .(lum t.lum)]
?. ?=($html -.ele)
(push (reso ele) ~)
:: begin reparsing of html that the spec jankily lets through ::
=+ tex=(trip (of-wain p.ele))
=^ mar lum (chomp tex (sear |=(a/marl ?~(a ~ (some a))) many:de-xml))
?^ mar
(push u.mar)
=^ hed lum (chomp tex head:de-xml)
?^ hed
=+ max=`marx`u.hed
(push(lum q) [max p] ~):[apex(had `n.max) .]
=^ tal lum (chomp tex tail:de-xml)
?~ tal
=^ cha lum (chomp tex prn)
?^ cha
(push ;/([u.cha]~) ~)
(push ;lost:"{tex}" ~)
?: =(had tal)
[~ lum]
?^ had
=. lum [ele lum]
(lose "unclosed {<u.had>}")
(lose "close {<u.tal>}")
:: end reparsing of html that the spec jankily lets through ::
::
++ lose |=(a/tape [[;lost:"{a}"]~ lum])
++ chomp
|* {tap/tape fel/rule}
^- {(unit _(wonk *fel)) _lum}
=+ vex=(fel 1^1 tap)
?~ q.vex [~ lum]
:- [~ (wonk vex)]
?~(q.q.u.q.vex lum [[%html (to-wain (crip q.q.u.q.vex))] lum])
::
++ push
|= a/marl
^+ apex
?~ a apex
[[b p] q]:[b=i.a (push t.a)]
::
++ reso
|= a/elem
?^ -.a
=. tig ?.(?=($list -.p.a) tig p.p.a)
?: &(tig ?=($item -.p.a))
[/li (sang q.a)]
%+ into-inner ^$(lum q.a)
?- -.p.a
$bloq ;blockquote;
$item ;li;
$list ?@ q.p.a ;ul;
?: =(1 p.q.p.a) ;ol;
=+ num=(en-json (numb:enjs p.q.p.a))
;ol(start num);
==
?- -.a :: ;/("unimplemented {<p.a>}")
$html !! :: handled earlier XX do type stuff
$para [/p (sung p.a)]
$head
=+ [hed=(add %h0 (lsh 3 1 p.a)) kid=(sung q.a)]
[[hed id+(sanitize kid) ~] kid]
::
$hrul ;hr;
$meta ?: =(~ p.a) ;/(~)
=+ jon=`json`o+(~(run by p.a) |=(cord s++<))
;meta(value "{(en-json jon)}", name "frontmatter", urb_front "");
:: %html
::=+ tex=(of-wain (turn p.a crip))
::=+ (de-xml tex)
::?^ - u.-
::=+ (rush tex (star ;~(pose gah comt:de-xml)))
::?^ - ;/(~)
::;lost: {<p.a>}
:: ;/([(of-wain (turn p.a crip))]~) :: XX haaaaaaack
$defn ;/(~)
$code =+ lan=?~(p.a ~ (first-word r.u.p.a))
=+ tex=(trip (of-wain q.a))
?~ lan ;pre:code:"{tex}"
;pre:code(class "language-{u.lan}"):"{tex}"
==
--
::
++ sung
|= lim/kids
=+ had=*(unit mane)
|^ ^- marl
=+ a=apex
?~ q.a
p.a
(weld p.a $(lim q.a))
::
++ apex
^- {p/marl q/_lim}
?~ lim
?~ had [~ ~]
(lose "unclosed {<u.had>}")
=> [ele=i.lim .(lim t.lim)]
?. ?=($htmt -.ele)
?: &(?=($$ -.ele) ?=({{$$ *} *} lim))
apex(p.i.lim (weld p.ele p.i.lim))
(push (reso ele) ~)
=+ tex=(trip p.ele)
=^ emo lim (chomp tex empt:de-xml)
?^ emo
=+ man=`manx`u.emo
(push man ~)
=^ hed lim (chomp tex head:de-xml)
?^ hed
=+ max=`marx`u.hed
(push(lim q) [max p] ~):[apex(had `n.max) .]
=^ tal lim (chomp tex tail:de-xml)
?~ tal
(push ;lost:"{tex}" ~)
?: =(had tal)
[~ lim]
?^ had
=. lim [ele lim]
(lose "unclosed {<u.had>}")
(lose "unopened {<u.tal>}")
::
++ lose |=(a/tape [[;lost:"{a}"]~ lim])
++ chomp
|* {tap/tape fel/rule}
^- {(unit _(wonk *fel)) _lim}
=+ vex=(fel 1^1 tap)
?~ q.vex [~ lim]
:- [~ (wonk vex)]
?~(q.q.u.q.vex lim [[%htmt (crip q.q.u.q.vex)] lim])
::
++ push
|= a/marl
^+ apex
?~ a apex
[[b p] q]:[b=i.a (push t.a)]
::
++ urly
|= a/tape ^- tape
?~ a ~
?: ?| [?=(^ q)]:(alp 1^1 a)
(~(has in (silt "#!*'();:@&=+$,/?/%.~_")) i.a) :: XX reparse
==
[i.a $(a t.a)]
(weld (en-urlt:html (trip i.a)) $(a t.a))
::
++ reso
|= b/inline
^- manx
?@ -.b
?- -.b
$$ ;/(p.b)
$line ;br;
$code ;code:"{p.b}"
$htmt !! ::p.b :: handled earlier :: XX do type stuff
==
?: ?=($blot -.p.b)
=+ res=`manx`;img(src (urly p.p.b), alt (flat (turn q.b ..$)));
:: ;img@"{p.p.b}";
?~ q.p.b res
res(a.g (welp a.g.res title+u.q.p.b ~))
=+ kid=(sung q.b)
%+ into-inner kid
?- p.b
{$emph ?} ?.(p.p.b ;em; ;strong;)
{$delt ~} ;del;
{$link ^} =+ url=(urly p.p.b)
=. url ?^(url url "#{(sanitize kid)}")
?~ q.p.b ;a/"{url}";
;a/"{url}"(title u.q.p.b);
==
--
--

3
lib/hall.hoon
View File

@ -1,11 +1,10 @@
::
:::: /lib/hall/hoon
::
/- hall
/- *hall
::
::::
::
=, hall
|_ bol/bowl:gall
::
::TODO add to zuse?

3
lib/hood/drum.hoon
View File

@ -2,9 +2,8 @@
:::: /hoon/drum/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole, hall
/- *sole, hall
/+ sole
=, ^sole
:: :: ::
:::: :: ::
:: :: ::

75
lib/hood/helm.hoon
View File

@ -3,7 +3,7 @@
:: :: ::
/? 310 :: version
/- sole, hall
[. sole]
/+ pill
:: :: ::
:::: :: ::
:: :: ::
@ -13,8 +13,8 @@
$: hoc/(map bone session) :: consoles
== ::
++ session ::
$: say/sole-share :: console state
mud/(unit (sole-dialog @ud)) :: console dialog
$: say/sole-share:sole :: console state
mud/(unit (sole-dialog:sole @ud)) :: console dialog
== ::
:: :: ::
:::: :: ::
@ -40,8 +40,7 @@
{$flog wire flog:dill} ::
[%mint wire our=ship p=ship q=safe:rights:jael]
{$nuke wire ship} ::
:: {$serv wire ?(desk beam)} ::
[%serve wire binding:light generator:light] ::
[%serve wire binding:light generator:light]
{$poke wire dock pear} ::
== ::
++ move (pair bone card) :: user-level move
@ -104,10 +103,6 @@
%^ emit %poke /helm/ask/(scot %p ~socden-malzod)
[[~socden-malzod %ask] %ask-mail mel]
::
:: ++ poke-serve
:: |= top/?(desk beam) =< abet
:: (emit %serv /helm/serv top)
::
++ poke-hi
|= mes/@t
~| %poke-hi-fail
@ -156,57 +151,23 @@
=+ way=?:(zus (welp top /sys/[nam]) (welp top /sys/vane/[nam]))
=+ fil=.^(@ %cx (welp way /hoon))
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
:: +poke-reset: send %vega to reboot kernel
::
++ poke-reset :: reset system
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
:- [%flog /reset %vega (weld top /hoon) (weld top /arvo)]
%+ turn
^- (list {p/@tas q/path})
:~ [%$ /zuse]
[%a /vane/ames]
[%b /vane/behn]
[%c /vane/clay]
[%d /vane/dill]
[%e /vane/eyre]
[%f /vane/ford]
[%g /vane/gall]
[%l /vane/light]
[%j /vane/jael]
==
|= {p/@tas q/path}
=+ way=`path`(welp top q)
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
:: And reinstall %zuse and the vanes.
:: Trigger with |reset.
::
++ poke-meset :: reset system (new)
|= hood-reset =< abet
%- emil
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/sys
=+ hun=.^(@ %cx (welp top /hoon/hoon))
=+ arv=.^(@ %cx (welp top /arvo/hoon))
:- [%flog /reset [%velo `@t`hun `@t`arv]]
:- =+ way=(weld top `path`/zuse)
[%flog /reset %veer %$ way .^(@ %cx (welp way /hoon))]
++ poke-reset
|= hood-reset
=< abet
%- emil %- flop
^- (list card)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
:- [%flog /reset [%vega `@t`hun `@t`arv]]
%+ turn
^- (list {p/@tas q/@tas})
:~ [%a %ames]
[%b %behn]
[%c %clay]
[%d %dill]
[%e %eyre]
[%f %ford]
[%g %gall]
[%l %light]
[%j %jael]
==
|= {p/@tas q/@tas}
=+ way=`path`(welp top /vane/[q])
=+ txt=.^(@ %cx (welp way /hoon))
[%flog /reset %veer p way txt]
(module-ova:pill top)
|=(a=[wire flog:dill] [%flog a])
::
++ poke-verb :: toggle verbose
|= ~ =< abet

107
lib/hood/kiln.hoon
View File

@ -61,19 +61,19 @@
?> =(src our)
=> |% :: arvo structures
++ card ::
$% {$build wire @p ? schematic:ford} ::
{$drop wire @p @tas} ::
{$info wire @p @tas nori} ::
$% {$build wire ? schematic:ford} ::
{$drop wire @tas} ::
{$info wire @tas nori} ::
{$mont wire @tas beam} ::
{$dirk wire @tas} ::
{$ogre wire $@(@tas beam)} ::
{$merg wire @p @tas @p @tas case germ} ::
{$perm wire ship desk path rite} ::
{$merg wire @tas @p @tas case germ} ::
{$perm wire desk path rite} ::
{$poke wire dock pear} ::
{$wipe wire @ud} ::
[%keep wire compiler-cache-size=@ud build-cache-size=@ud]
{$wait wire @da} ::
{$warp wire sock riff} ::
{$warp wire ship riff} ::
== ::
++ pear :: poke fruit
$% {$hall-command command:hall} ::
@ -130,7 +130,7 @@
|= hos/kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:(start-sync:(auto hos) |)
abet:abet:start-sync:(auto hos)
::
++ poke-syncs :: print sync config
|= ~
@ -140,12 +140,6 @@
%+ turn ~(tap in ~(key by syn))
|=(a/kiln-sync (render "sync configured" [sud her syd]:a))
::
++ poke-init-sync
|= hos/kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:(start-sync:(auto hos) &)
::
++ poke-unsync ::
|= hus/kiln-unsync
?. (~(has by syn) hus)
@ -160,13 +154,13 @@
::
++ poke-cancel
|= syd/desk
abet:(emit %drop /cancel our syd)
abet:(emit %drop /cancel syd)
::
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
abet:(emit:(spam leaf+mez ~) %info /kiln our u.tor)
abet:(emit:(spam leaf+mez ~) %info /kiln u.tor)
::
++ poke-rm
|= a/path
@ -191,8 +185,8 @@
++ poke-permission
|= {syd/desk pax/path pub/?}
=< abet
%^ emit %perm /kiln/permission
[our syd pax %r ~ ?:(pub %black %white) ~]
%- emit
[%perm /kiln/permission syd pax %r ~ ?:(pub %black %white) ~]
::
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
++ poke-start-autoload |=(~ abet:start:autoload)
@ -231,9 +225,7 @@
++ subscribe-next
%- emit
^- card
:* %warp /kiln/autoload [our our] %home ~
%next %z da+now /sys
==
[%warp /kiln/autoload our %home `[%next %z da+now /sys]]
::
++ writ =>(check-new subscribe-next)
++ check-new
@ -326,7 +318,7 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(mere:(auto hos) .?(t.t.t.way) mes)
abet:abet:(mere:(auto hos) mes)
::
++ take-writ-sync ::
|= {way/wire rot/riot}
@ -336,7 +328,7 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) .?(t.t.t.way) rot)
abet:abet:(writ:(auto hos) rot)
::
++ take-writ-autoload
|= {way/wire rot/riot}
@ -372,49 +364,50 @@
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
%- blab :_ ~
:* ust %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~
==
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ust %warp wire her sud ~] ~)
:: XX duplicate of start-sync? see |track
::
++ start-track
=> (spam (render "activated track" sud her syd) ~)
=. let 1
%- blab
:~ :* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %y ud+let /
== ==
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+let /]] ~)
::
++ start-sync
|= reset/?
=. +>.$ (spam (render "activated sync" sud her syd) ~)
%- blab
:~ :* ost %warp
[%kiln %sync syd (scot %p her) sud ?:(reset /reset /)]
[our her] sud ~ %sing %w [%da now] /
== ==
=< (spam (render "activated sync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %w [%da now] /]] ~)
::
++ writ
|= {reset/? rot/riot}
|= rot=riot
?~ rot
%^ spam
leaf+"bad %writ response"
(render "on sync" sud her syd)
~
=. let ?. ?=($w p.p.u.rot) let ud:((hard cass:clay) q.q.r.u.rot)
%- blab ^- (list move) :_ ~
:* ost %merg
[%kiln %sync syd (scot %p her) sud ?:(reset /reset /)]
our syd her sud ud+let
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
%init
%mate
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
=/ =cass .^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
::
:: If we will be syncing in remote changes, we need all our sync merges
:: up to and including the first remote sync to use the %init germ.
:: Otherwise we won't have a merge-base with our sponsor.
::
=/ bar=@ud
?: ?| ?=(?($czar $pawn) (clan:title our))
!?=(%home syd)
==
2
3
=/ =germ ?:((gte bar ud.cass) %init %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
(blab [ost %merg wire syd her sud ud+let germ] ~)
::
++ mere
|= {reset/? mes/(each (set path) (pair term tang))}
|= mes=(each (set path) (pair term tang))
=. let +(let)
=. +>.$
%- spam
@ -434,14 +427,8 @@
leaf+"note: blank desk {<sud>} on {<her>}"
==
==
=. +>.$
?. reset +>.$
(blab [ost %poke /init-reset [our %hood] %helm-reset ~]~)
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %y ud+let /
==
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+let /]] ~)
--
::
++ work :: state machine
@ -476,7 +463,7 @@
::
++ perform ::
^+ .
(blab [ost %merg /kiln/[syd] our syd her sud cas gem] ~)
(blab [ost %merg /kiln/[syd] syd her sud cas gem] ~)
::
++ fancy-merge :: send to self
|= {syd/desk her/@p sud/desk gem/?($auto germ)}
@ -502,7 +489,7 @@
?~ saw
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
[ost %merg /kiln/[syd] our (cat 3 syd '-scratch') her sud cas gem]
[ost %merg /kiln/[syd] (cat 3 syd '-scratch') her sud cas gem]
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> u.saw)
@ -521,7 +508,7 @@
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
=, ford
:* ost %build /kiln/[syd] our live=%.n
:* ost %build /kiln/[syd] live=%.n
^- schematic
:- %list
^- (list schematic)
@ -650,7 +637,7 @@
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd] our
:* ost %info /kiln/[syd]
(cat 3 syd '-scratch') %&
%+ murn can
|= {p/path q/(unit miso)}

11
lib/hood/write.hoon
View File

@ -16,8 +16,8 @@
::
|%
++ data $%({$json json} {$mime mime})
++ card $% {$build wire @p ? schematic:ford}
{$info wire @p toro:clay}
++ card $% {$build wire ? schematic:ford}
{$info wire toro:clay}
==
--
::
@ -34,7 +34,7 @@
=+ ext=%md
?~ (file (en-beam beak-now [ext sup]))
~|(not-found+[ext `path`(flop sup)] !!)
=- abet:(emit %info write+~ our -)
=- abet:(emit %info write+~ -)
(fray (en-beam beak-now [ext sup]))
::
++ poke-tree
@ -57,7 +57,7 @@
=+ .^(path %e /(scot %p our)/serv/(scot %da now))
?>(?=({@tas @tas *} -) -)
=; sob/soba:clay
?~(sob abet abet:(emit %info write+~ our `toro:clay`[i.t.sev %& sob]))
?~(sob abet abet:(emit %info write+~ `toro:clay`[i.t.sev %& sob]))
=+ pax=`path`/web/plan
=+ paf=(en-beam beak-now (flop pax))
?~ [fil:.^(arch %cy paf)]
@ -134,7 +134,6 @@
%- emit :*
%build
write+pax
our
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
@ -157,7 +156,7 @@
::
=/ =cage (result-to-cage:ford build-result)
::
=- abet:(emit %info write+~ our -)
=- abet:(emit %info write+~ -)
::
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
--

143
lib/keygen.hoon
View File

@ -2,95 +2,93 @@
::
/- keygen
::
/+ bip32
/+ bip32, bip39
::
::
=, sha
=, keygen
::
|%
++ to-byts
|= a=@t
=+ (met 3 a)
[- (rev 3 - a)]
::
++ argon2u
|= [inp=byts out=@ud]
|= [who=ship tic=byts]
^- @
%- (argon2-urbit:argon2:crypto out)
[inp (to-byts 'urbitkeygen')]
~| [%who who (met 3 who)]
:: ?> (lte (met 3 who) 4)
%- (argon2-urbit:argon2:crypto 32)
:- tic
=- [(met 3 -) (swp 3 -)]
%- crip
(weld "urbitkeygen" (a-co:co who))
::
++ child-node-from-seed
|= [seed=byts met=meta pass=(unit @t)]
|= [seed=@ typ=tape pass=(unit @t)]
^- node
=+ dr=~(. sd pass)
=+ child-seed=(seed:dr seed met)
:+ met dat.child-seed
(wallet:dr child-seed)
=+ sed=(seed:ds 32^seed typ)
=+ nom=(from-entropy:bip39 32^sed)
:+ typ nom
%- wallet:ds
%+ to-seed:bip39 nom
(trip (fall pass ''))
::
++ derive-network-seed
|= [mngs=@ rev=@ud]
^- @ux
=+ (seed:ds 64^mngs (weld "network" (a-co:co rev)))
?: =(0 rev) -
:: hash again to prevent length extension attacks
(sha-256l:sha 32 -)
::
++ full-wallet-from-ticket
|= [ticket=byts seed-size=@ud sis=(set ship) pass=(unit @t) revs=revisions]
=+ owner-seed=seed-size^(argon2u ticket seed-size)
(full-wallet-from-seed owner-seed sis pass revs)
:: who: username
:: ticket: password
:: rev: network key revision
:: pass: optional passphrase
::
++ full-wallet-from-seed
|= [owner-seed=byts sis=(set ship) pass=(unit @t) revs=revisions]
=+ dr=~(. sd pass)
=+ cn=|=([s=byts m=meta] (child-node-from-seed s m pass))
|= [who=ship ticket=byts rev=@ud pass=(unit @t)]
^- vault
=+ master-seed=(argon2u who ticket)
=/ cn :: child node
|= typ=nodetype
(child-node-from-seed master-seed typ pass)
::
:- ^= owner ^- node
:+ *meta dat.owner-seed
(wallet:dr owner-seed)
:- ^= ownership ^- node
(cn "ownership")
::
:- ^= delegate
(cn owner-seed "delegate" delegate.revs ~)
:- ^= voting ^- node
(cn "voting")
::
=/ manage=node
(cn owner-seed "manage" manage.revs ~)
:- manage=manage
=/ management=node
(cn "management")
:- management=management
::
:- ^= transfer
%- ~(rep in sis)
|= [s=ship n=nodes]
%+ ~(put by n) s
(cn owner-seed "transfer" transfer.revs `s)
:- ^= transfer ^- node
(cn "transfer")
::
:- ^= spawn
%- ~(rep in sis)
|= [s=ship n=nodes]
%+ ~(put by n) s
(cn owner-seed "spawn" spawn.revs `s)
:- ^= spawn ^- node
(cn "spawn")
::
^= network
%- ~(rep in sis)
|= [s=ship u=uodes]
%+ ~(put by u) s
=+ m=["network" network.revs `s]
=+ s=(seed:dr [wid.owner-seed seed.manage] m)
[m dat.s (urbit:dr s)]
::
++ sd :: seed derivation
|_ pass=(unit @t)
++ append-pass
|= b=byts
^- byts
=+ (fall pass '')
:- (add wid.b (met 3 -))
(cat 3 (swp 3 -) dat.b)
^= network ^- uode
=/ mad :: management seed
%+ to-seed:bip39
seed:management
(trip (fall pass ''))
=+ sed=(derive-network-seed mad rev)
[rev sed (urbit:ds sed)]
::
++ ds :: derive from raw seed
|%
++ wallet
%+ cork append-pass
|= seed=byts
|= seed=@
^- ^wallet
=> (from-seed:bip32 64^(sha-512l seed))
[public-key private-key chain-code]
=+ => (from-seed:bip32 64^seed)
(derive-path "m/44'/60'/0'/0/0")
:+ [public-key private-key]
(address-from-prv:ethereum private-key)
chain-code
::
++ urbit
%+ cork append-pass
|= seed=byts
|= seed=@
^- edkeys
=+ =< [pub=pub:ex sec=sec:ex]
(pit:nu:crub:crypto (mul 8 wid.seed) dat.seed)
(pit:nu:crub:crypto 256 seed)
:- ^= auth
:- (rsh 3 1 (end 3 33 pub))
(rsh 3 1 (end 3 33 sec))
@ -99,17 +97,10 @@
(rsh 3 33 sec)
::
++ seed
|= [seed=byts meta]
^- byts
:- wid.seed
%^ rsh 3 (sub 64 wid.seed)
%- sha-512l
%- append-pass
=+ ;: weld
typ "-" (a-co:co rev)
?~(who ~ ['-' (a-co:co u.who)])
==
:- (add wid.seed (lent -))
(cat 3 (crip (flop -)) dat.seed)
|= [seed=byts salt=tape]
^- @ux
%- sha-256l:sha
:- (add wid.seed (lent salt))
(cat 3 (crip (flop salt)) dat.seed)
--
--

125
lib/pill.hoon Normal file
View File

@ -0,0 +1,125 @@
:: |pill: helper functions for making pills
::
^?
|%
:: +module-ova: vane load operations.
::
:: sys: full path to /sys directory
::
++ module-ova
|= sys=path
^- (list [wire [%veer term path cord]])
%+ turn
^- (list (pair term path))
:~ :: sys/zuse: standard library
::
[%$ /zuse]
:: sys/vane/ames: network
::
[%a /vane/ames]
:: sys/vane/behn: timer
::
[%b /vane/behn]
:: sys/vane/clay: revision control
::
[%c /vane/clay]
:: sys/vane/dill: console
::
[%d /vane/dill]
:: sys/vane/eyre: web
::
:: [%e /vane/eyre]
:: sys/vane/ford: build
::
[%f /vane/ford]
:: sys/vane/gall: applications
::
[%g /vane/gall]
:: sys/vane/jael: security
::
[%j /vane/jael]
:: sys/vane/light: new web
::
[%l /vane/light]
==
|= [=term =path]
=/ pax (weld sys path)
=/ txt .^(@ %cx (weld pax /hoon))
[[%vane path] [%veer term pax txt]]
:: +file-ovum: userspace filesystem load
::
:: bas: full path to / directory
::
++ file-ovum
|= bas=path
^- ovum
::
:: /app %gall applications
:: /gen :dojo generators
:: /lib %ford libraries
:: /mar %ford marks
:: /ren %ford renderers
:: /sec %eyre security drivers
:: /sur %ford structures
:: /sys system files
:: /tests unit tests
:: /web %eyre web content
::
%. [/app /gen /lib /mar /ren /sec /sur /sys /tests /web ~]
|= :: sal: all spurs to load from
::
sal/(list spur)
^- ovum
::
:: hav: all user files
::
=; hav ~& user-files+(lent hav)
[[%$ %sync ~] [%into %$ & hav]]
=| hav/mode:clay
|- ^+ hav
?~ sal ~
=. hav $(sal t.sal)
::
:: tyl: spur
::
=/ tyl i.sal
|- ^+ hav
::
:: pax: full path at `tyl`
:: lon: directory at `tyl`
::
=/ pax (weld bas (flop tyl))
=/ lon .^(arch %cy pax)
:: XX this serialization should use marks
::
=? hav ?=(^ fil.lon)
?. ?= ?($css $hoon $js $json $md $txt $udon $umd)
-.tyl
::
:: install only files with whitelisted marks
::
~& ignoring+pax
hav
::
:: cot: file as plain-text octet-stream
::
=; cot [[(flop `path`tyl) `[/text/plain cot]] hav]
^- octs
?- tyl
{$json *}
=/ dat .^(json %cx pax)
(as-octt:mimes:html (en-json:html dat))
::
{$txt *}
=/ dat .^(wain %cx pax)
(as-octs:mimes:html (of-wain:format dat))
::
*
=/ dat .^(@t %cx pax)
[(met 3 dat) dat]
==
=/ all ~(tap by dir.lon)
|- ^- mode:clay
?~ all hav
$(all t.all, hav ^$(tyl [p.i.all tyl]))
--

4
lib/sole.hoon
View File

@ -2,9 +2,7 @@
:::: /hoon/sole/lib
::
/? 310
/- sole
=, sole
::
/- *sole
::::
::
|_ sole-share :: shared-state engine

10
lib/test.hoon
View File

@ -25,6 +25,16 @@
(~(dunk ut p.expected) %expected)
== ==
result
:: +expect-fail: kicks a trap, expecting crash. pretty-prints if succeeds
::
++ expect-fail
|= a=(trap)
^- tang
=/ b (mule a)
?- -.b
%| ~
%& [leaf+"expected failure - succeeded" ~]
==
:: +category: prepends a name to an error result; passes successes unchanged
::
++ category

157
lib/twitter.hoon
View File

@ -1,157 +0,0 @@
:: A Twitter API library.
::
:::: /hoon/twitter/lib
::
/? 314
/- twitter
/+ interpolate, hep-to-cab
=+ sur-twit:^twitter :: XX
=, eyre
=, mimes:html
=, html
=, format
=, html
=, chrono:userlib
::
:::: functions
::
|%
++ join
|= {a/char b/(list @t)} ^- @t
%+ rap 3
?~ b ~
|-(?~(t.b b [i.b a $(b t.b)]))
::
++ valve :: produce request
|= {med/?($get $post) pax/path quy/quay}
^- hiss
=+ url=(scan "https://api.twitter.com/1.1/.json" auri:de-purl) :: base path
=. q.q.url (welp q.q.url pax)
=. r.url quy
^- hiss
?- med
$get [url med *math ~]
$post
=+ hed=(my:nl content-type+['application/x-www-form-urlencoded']~ ~)
[url(r ~) med hed ?~(r.url ~ (some (as-octt +:(tail:en-purl r.url))))]
==
::
++ find-req
=+ all=doc-data-dry:reqs
|: a=-:$:endpoint:reqs ^- {?($get $post) path}
?~ all ~|(endpoint-lost+a !!) :: type error, should never happen
?: =(a -:$:typ.i.all)
+.i.all
$(all t.all)
--
::
:::: library
::
|%
++ render :: response printers
=+ args:reqs
|%
++ mean
|= {msg/@t num/@ud} ^- tank
rose+[": " `~]^~[leaf+"Error {<num>}" leaf+(trip msg)]
::
++ user-url
|: a=$:scr ^- purf
:_ ~
%^ into-url:interpolate 'https://twitter.com/:scr'
~
~[scr+a]
::
++ post-url
|: $:{a/scr b/tid} ^- purf
:_ ~
%^ into-url:interpolate 'https://twitter.com/:scr/status/:tid'
~
~[scr+a tid+(tid:print b)]
--
++ parse ^? :: text parsers
|%
++ user (cook crip (plus ;~(pose aln cab)))
--
::
++ reparse :: json reparsers
=, parse
|%
++ ce |*({a/$-(* *) b/fist:dejs} (cu:dejs |:(c=$:a c) b)) :: output type
++ fasp |*(a/{@tas *} [(hep-to-cab -.a) +.a])
++ mean (ot errors+(ar (ot message+so code+ni ~)) ~):dejs
++ post
=, ^?(dejs)
%+ ce post:sur-twit
%- ot
:~ id+ni
user+(ot (fasp screen-name+(su user)) ~)
(fasp created-at+(cu year (ci stud so)))
:: parse html escapes and newlines
text+(cu crip (su (star ;~(pose (just `@`10) escp:de-xml))))
==
++ usel
=, ^?(dejs)
%+ ce (list who/@ta)
=- (ot users+(ar -) ~)
(ot (fasp screen-name+(su user)) ~)
--
++ print
=+ args:reqs
|%
++ tid |=(@u `@t`(rsh 3 2 (scot %ui +<)))
++ scr |=(@t +<)
++ lsc
|: a=$:$@(^scr ^lsc) ^- @t
?@(a `@t`a (join ',' a))
::
++ lid
|: a=$:$@(^tid (list ^tid)) ^- @t
?~ a ~|(%nil-id !!)
?@(a (tid a) (join ',' (turn `(list ^tid)`a tid)))
--
++ request
=< apex
=+ args:reqs
|%
++ apex
|: $:{a/endpoint b/quay} ^- hiss
=+ [med pax]=(find-req -.a)
(valve med (cowl pax +.a b))
::
++ lutt |=(@u `@t`(rsh 3 2 (scot %ui +<)))
++ llsc
:: => args:reqs
|: a=$:$@(scr (list scr)) ^- @t
?@(a `@t`a (join ',' a))
::
++ llst
|= a/$@(@t (list @t)) ^- @t
?@(a `@t`a (join ',' a))
::
++ llid
:: =+ args:reqs
|: a=$:$@(tid (list tid)) ^- @t
?~ a ~|(%nil-id !!)
?@(a (lutt a) (join ',' (turn `(list tid)`a lutt)))
::
++ cowl :: handle parameters
|= $: pax/path
ban/(list param)
quy/quay
==
^- {path quay}
%+ into-path-partial:interpolate
(path:hep-to-cab pax)
=- (weld - quy)
%+ turn ban
|: p=$:param
^- {@t @t}
:- (hep-to-cab -.p)
?+ -.p p.p :: usually plain text
?($source-id $target-id) (tid:print p.p)
?($id $name $user-id) (lid:print p.p)
$screen-name (lsc:print p.p)
==
--
--

17
mar/coffee.hoon
View File

@ -1,17 +0,0 @@
::
:::: /hoon/coffee/mar
::
/? 310
=, mimes:html
|_ mud/@t
++ grow
|%
++ mime [/text/coffeescript (as-octs mud)]
--
++ grab
|%
++ mime |=({p/mite q/octs} (@t q.q))
++ noun @t
--
++ grad %mime
--

38
mar/down.hoon
View File

@ -1,38 +0,0 @@
::
:::: /hoon/down/mar
::
/? 310
/- markdown
/+ down-jet, frontmatter
::
::::
::
=, format
=, markdown
|_ don/down
++ grab :: convert from
|%
++ noun down :: clam from %noun
++ md
|= src/@t
=+ [atr mud]=(parse:frontmatter (to-wain src))
[[%meta atr] (mark:down-jet mud)]
--
::
++ grow :: convert into
|%
++ front ?~(don ~ ?:(?=($meta -.i.don) p.i.don front(don t.don)))
++ hymn :: convert to %hymn
;html
;head:title:"Untitled"
;body
;* (print:down-jet don)
==
==
++ elem :: convert to %elem
;div
;* (print:down-jet don)
==
:: ++ react elem
--
--

10
mar/gh/commit.hoon
View File

@ -1,10 +0,0 @@
/- gh
/+ gh-parse, httr-to-json
|_ commit/commit:gh
++ grab
|%
++ noun commit:gh
++ httr (cork httr-to-json json)
++ json commit:gh-parse
--
--

42
mar/gh/issue-comment.hoon
View File

@ -1,42 +0,0 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse, hall
|_ issue-comment/issue-comment:gh
++ grow
|%
++ hall-speeches
^- (list speech:hall)
:_ ~
=+ ^= txt
;: (cury cat 3)
'on issue #'
`@t`(rsh 3 2 (scot %ui number.issue.issue-comment))
': '
body.comment.issue-comment
==
:* %api %github
login.sender.issue-comment
(rash html-url.sender.issue-comment aurf:urlp)
txt
txt
(rash html-url.comment.issue-comment aurf:urlp)
%- jobe :~
repository+s+name.repository.issue-comment
number+(numb:enjs:format number.issue.issue-comment)
title+s+title.issue.issue-comment
==
==
--
++ grab
|%
++ json
=; jop |=(jon/^json `issue-comment:gh`(need (jop jon)))
%- ot:dejs-soft:format
:~ repository+repository:gh-parse
sender+user:gh-parse
action+so:dejs-soft:format
issue+issue:gh-parse
comment+comment:gh-parse
==
--
--

17
mar/gh/issue.hoon
View File

@ -1,17 +0,0 @@
/- gh
/+ gh-parse, httr-to-json
=, mimes:html
|_ issue/issue:gh
++ grab
|%
++ noun issue:gh
++ httr (cork httr-to-json json)
++ json issue:gh-parse
--
++ grow
|%
++ json raw.issue
++ mime [/txt/plain (as-octs (crip <issue>))]
++ txt (print-issue:gh-parse issue)
--
--

139
mar/gh/issues.hoon
View File

@ -1,139 +0,0 @@
:: Converts the result of an 'issues' event into a issues:gh.
/- gh
/+ gh-parse, hall
|_ issues/issues:gh
++ grow
|%
++ hall-speeches
^- (list speech:hall)
:_ ~
=+ ^= txt
?- -.action.issues
$assigned
;: (cury cat 3)
'assigned issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' to '
login.assignee.action.issues
' ('
title.issue.issues
')'
==
::
$unassigned
;: (cury cat 3)
'unassigned issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' from '
login.assignee.action.issues
' ('
title.issue.issues
')'
==
::
$labeled
;: (cury cat 3)
'labeled issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' as '
name.label.action.issues
' ('
title.issue.issues
')'
==
::
$unlabeled
;: (cury cat 3)
'unlabeled issue #'
(rsh 3 2 (scot %ui number.issue.issues))
' as '
name.label.action.issues
' ('
title.issue.issues
')'
==
::
$opened
;: (cury cat 3)
'opened issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
::
$closed
;: (cury cat 3)
'closed issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
::
$reopened
;: (cury cat 3)
'reopened issue #'
(rsh 3 2 (scot %ui number.issue.issues))
': '
title.issue.issues
==
==
^- speech:hall
:* %api %github
login.sender.issues
(rash html-url.sender.issues aurf:urlp)
txt txt
(rash html-url.issue.issues aurf:urlp)
%- jobe
%+ welp
:~ repository+s+name.repository.issues
number+(jone number.issue.issues)
title+s+title.issue.issues
action+s+-.action.issues
==
?- -.action.issues
$assigned
:~ assignee+s+login.assignee.action.issues
assignee-url+s+url.assignee.action.issues
==
::
$unassigned
:~ assignee+s+login.assignee.action.issues
assignee-url+s+url.assignee.action.issues
==
::
$labeled
:~ label+s+name.label.action.issues
==
::
$unlabeled
:~ label+s+name.label.action.issues
==
::
$opened ~
$closed ~
$reopened ~
==
==
--
++ grab
|%
++ json
|= jon/^json
^- issues:gh
=+ top=(need ((om:dejs-soft:format some) jon))
:* (need (repository:gh-parse (~(got by top) %repository)))
(need (user:gh-parse (~(got by top) %sender)))
=+ action=(need (so:dejs-soft:format (~(got by top) %action)))
?+ action ~|([%bad-action action] !!)
$assigned [action (need (user:gh-parse (~(got by top) %assignee)))]
$unassigned [action (need (user:gh-parse (~(got by top) %assignee)))]
$labeled [action (need (label:gh-parse (~(got by top) %label)))]
$unlabeled [action (need (label:gh-parse (~(got by top) %label)))]
$opened [action ~]
$closed [action ~]
$reopened [action ~]
==
(need (issue:gh-parse (~(got by top) %issue)))
==
--
--

18
mar/gh/list-issues.hoon
View File

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

6
mar/gh/poke.hoon
View File

@ -1,6 +0,0 @@
|_ {method/meth:eyre endpoint/(list @t) jon/json}
++ grab
|%
++ noun {method/meth:eyre endpoint/(list @t) jon/json}
--
--

10
mar/gh/repository.hoon
View File

@ -1,10 +0,0 @@
/- gh
/+ gh-parse, httr-to-json
|_ repo/repository:gh
++ grab
|%
++ noun repository:gh
++ httr (cork httr-to-json json)
++ json repository:gh-parse
--
--

18
mar/jam-crub.hoon
View File

@ -1,18 +0,0 @@
::
:::: /hoon/jam-crub/mar
::
/? 310
::
=, mimes:html
|_ mud/@
++ grow
|%
++ mime [/application/octet-stream (as-octs mud)]
--
++ grab
|% :: convert from
++ noun @ :: clam from %noun
++ mime |=({* octs} q)
--
++ grad %mime
--

24
mar/markdown.hoon
View File

@ -1,24 +0,0 @@
::
:::: /hoon/markdown/mar
::
/? 310
::
=, mimes:html
=, format
|_ mud/@t
++ grow
|%
++ mime [/text/x-markdown (as-octs mud)]
++ md mud
++ txt
(to-wain mud)
--
++ grab
|%
++ mime |=({p/mite q/octs} q.q)
++ noun @t
++ md |=(@t +<)
++ txt of-wain
--
++ grad %txt
--

21
mar/md.hoon
View File

@ -1,21 +0,0 @@
::
:::: /hoon/md/mar
::
/? 310
::
|_ mud/@t
++ grow
|%
++ mime [/text/x-markdown (as-octs:mimes:html mud)]
++ txt
(to-wain:format mud)
--
++ grab
|%
++ mime |=({p/mite:eyre q/octs:eyre} q.q)
++ noun @t
++ txt of-wain:format
--
++ grad %txt
++ garb /down
--

26
mar/tree/comments.hoon
View File

@ -1,26 +0,0 @@
::
:::: /hoon/comments/tree/mar
::
/? 310
/+ elem-to-react-json, time-to-id
=, format
::
::::
::
|_ all/(list (pair time {ship marl}))
::
++ grow :: convert to
|%
++ json
:- %a
%+ turn
(sort all |=({a/* b/*} (lor b a)))
|= {a/time b/ship c/marl} ^- ^json
=+ bod=[[%div id+(time-to-id a) ~] c]
=, enjs
(pairs time+(time a) user+(ship b) body+(elem-to-react-json bod) ~)
--
++ grab |% :: convert from
++ noun (list {time manx}) :: clam from %noun
::++ elem |=(a=manx `_all`[[/ ((getall %h1) a)] ~ ~])
-- --

8
mar/tree/elem.hoon
View File

@ -1,8 +0,0 @@
::
:::: /hoon/elem/tree/mar
::
/? 310
|_ own/manx
::
++ grow |% ++ elem own :: alias
-- --

15
mar/tree/hymn.hoon
View File

@ -1,15 +0,0 @@
::
:::: /hoon/hymn/tree/mar
::
/? 310
=, mimes:html
|_ own/manx
::
++ grow :: convert to
|%
++ html (crip (en-xml:^html own)) :: convert to %html
++ mime [/text/html (as-octs html)] :: convert to %mime
--
++ grab |% :: convert from
++ noun manx :: clam from %noun
-- --

8
mar/tree/include.hoon
View File

@ -1,8 +0,0 @@
::
:::: /hoon/include/tree/mar
::
/? 310
/- tree-include
|_ tree-include
++ grab |% ++ noun tree-include
-- --

23
mar/tree/index.hoon
View File

@ -1,23 +0,0 @@
::
:::: /hoon/index/tree/mar
::
/? 310
/+ tree,map-to-json,elem-to-react-json
[. tree]
::
::::
::
|_ all/(map path marl)
::
++ grow :: convert to
|%
++ json
%. all
%+ map-to-json
|=(a/path (crip (spud a)))
|=(a/marl [%a (turn a elem-to-react-json)])
--
++ grab |% :: convert from
++ noun (map path marl) :: clam from %noun
::++ elem |=(a=manx `_all`[[/ ((getall %h1) a)] ~ ~])
-- --

20
mar/tree/json.hoon
View File

@ -1,20 +0,0 @@
::
:::: /hoon/json/tree/mar
::
/? 310
::
:::: compute
::
=, mimes:html
=, html
|_ jon/json
::
++ grow :: convert to
|%
++ mime [/text/json (as-octt (en-json jon))] :: convert to %mime
--
++ grab
|% :: convert from
++ noun json :: clam from %noun
--
--

22
mar/twit/cred.hoon
View File

@ -1,22 +0,0 @@
:: Twitter credentials
::
:::: /hoon/cred/twit/mar
::
/- plan-acct
/+ httr-to-json, twitter
|_ {acc/plan-acct raw/json}
++ grab
|%
++ noun {plan-acct ^json}
++ httr (cork httr-to-json json) :: XX mark translation
++ json
|= jon/^json ^- {plan-acct ^json}
=+ usr=(need ((ot 'screen_name'^so ~):dejs-soft:format jon))
=+ url=(user-url:render:twitter usr)
[[usr (some url)] jon]
--
++ grow
|%
++ tank >[+<.+]<
--
--

31
mar/twit/feed.hoon
View File

@ -1,31 +0,0 @@
:: Twitter statuses
::
:::: /hoon/feed/twit/mar
::
/- hall
/+ twitter, httr-to-json
=, format
|_ fed/(list post:twitter)
++ grab
|%
++ noun (list post:twitter)
++ json (ar:dejs post:reparse:twitter)
++ httr (cork httr-to-json json) :: XX mark translation
--
++ grow
|%
++ tank >[fed]<
++ hall-speeches
=+ r=render:twitter
%+ turn fed
|= a/post:twitter ^- speech:hall
:* %api %twitter
who.a
(user-url.r who.a)
txt.a
txt.a
(post-url.r who.a id.a)
(joba now+(jode now.a))
==
--
--

17
mar/twit/post.hoon
View File

@ -1,17 +0,0 @@
:: Twitter status
::
:::: /hoon/post/twit/mar
::
/+ twitter, httr-to-json
|_ post:twitter
++ grab
|%
++ noun post:twitter
++ json post:reparse:twitter
++ httr (cork httr-to-json json) :: XX mark translation
--
++ grow
|%
++ tank >[+<]<
--
--

15
mar/twit/req.hoon
View File

@ -1,15 +0,0 @@
:: Twitter api request
::
:::: /hoon/req/twit/mar
::
/+ twitter
|_ {req/endpoint:reqs:twitter quy/quay}
++ grab
|%
++ noun {endpoint:reqs:twitter quay}
--
++ grow
|%
++ hiss (request:twitter req quy)
--
--

17
mar/twit/usel.hoon
View File

@ -1,17 +0,0 @@
:: List of twitter users
::
:::: /hoon/usel/twit/mar
::
/+ twitter, httr-to-json
|_ (list who/@ta)
++ grab
|%
++ noun (list who/@ta)
++ json usel:reparse:twitter
++ httr (cork httr-to-json json) :: XX mark translation
--
++ grow
|%
++ tank >[+<]<
--
--

79
mar/unicode-data.hoon
View File

@ -1,79 +0,0 @@
/- unicode-data
=, eyre
=, format
::
|_ all/(list line:unicode-data)
++ grab
:: converts from mark to unicode-data.
|%
++ mime |=([* a=octs] (txt (to-wain q.a))) :: XX mark translation
++ txt
|^ |= a=wain
^+ all
%+ murn a
|= b=cord
^- (unit line:unicode-data)
?~ b ~
`(rash b line)
::
:: parses a single character information line of the unicode data file.
++ line
;~ (glue mic)
hex :: code/@c codepoint in hex format
name-string :: name/tape character name
general-category :: gen/general type of character
(bass 10 (plus dit)) :: can/@ud canonical combining class
bidi-category :: bi/bidi bidirectional category
decomposition-mapping :: de/decomp decomposition mapping
::
:: todo: decimal/digit/numeric need to be parsed.
::
string-number :: decimal/tape decimal digit value (or ~)
string-number :: digit/tape digit value, even if non-decimal
string-number :: numeric/tape numeric value, including fractions
::
(fuss 'Y' 'N') :: mirrored/? is char mirrored in bidi text?
name-string :: old-name/tape unicode 1.0 compatibility name
name-string :: iso/tape iso 10646 comment field
(punt hex) :: up/(unit @c) uppercase mapping codepoint
(punt hex) :: low/(unit @c) lowercase mapping codepoint
(punt hex) :: title/(unit @c) titlecase mapping codepoint
==
::
:: parses a single name or comment string.
++ name-string
%+ cook
|=(a=tape a)
(star ;~(less mic prn))
::
:: parses a unicode general category abbreviation to symbol
++ general-category
%+ sear (soft general:unicode-data)
:(cook crip cass ;~(plug hig low (easy ~)))
::
:: parses a bidirectional category abbreviation to symbol.
++ bidi-category
%+ sear (soft bidi:unicode-data)
:(cook crip cass (star hig))
::
++ decomposition-mapping
%- punt :: optional
:: a tag and a list of characters to decompose to
;~ plug
(punt (ifix [gal ;~(plug gar ace)] decomp-tag))
(cook |=(a=(list @c) a) (most ace hex))
==
::
++ decomp-tag
%+ sear (soft decomp-tag:unicode-data)
:(cook crip cass (star alf))
::
++ string-number
%+ cook
|=(a=tape a)
(star ;~(pose nud net hep))
::
--
--
++ grad %txt
--

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

@ -1,57 +0,0 @@
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"})
}
urb.waspElem = function(ele){
url = ele.src || ele.href
if(!url || (new URL(url)).host != document.location.host)
return;
urb.waspUrl(url)
}
urb.waspUrl = function(url){
var xhr = new XMLHttpRequest()
xhr.open("HEAD", url)
xhr.send()
xhr.onload = urb.waspLoadedXHR
xhr.channel = url
}
urb.waspLoadedXHR = function(){
urb.sources[urb.getXHRWasp(this)] = this.channel
urb.wasp(urb.getXHRWasp(this))
}
urb.getXHRWasp = function(xhr){
var dep = xhr.getResponseHeader("etag")
if(dep) return JSON.parse(dep.substr(2))
}
urb.datadeps = {}
urb.waspData = function(dep){
urb.datadeps[dep] = true
urb.wasp(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')
}

18
ren/tree/index.hoon
View File

@ -1,18 +0,0 @@
::
:::: /hoon/index/tree/ren
::
/? 310
/+ tree
/, /
/; (getall:tree /h1/h2/h3/h4/h5/h6) /tree-elem/
::
/pub/docs/dev/hoon/runes
/; |= {tip/marl sub/(map knot marl) ~}
(zing `(list marl)`[tip (turn ~(tap by sub) tail)])
/. /; (getall:tree %h1 ~) /tree-elem/
/_ /; (getall:tree %h1 ~) /tree-elem/
== ==
::
::::
::
`(map path marl)`[[/ -.-] ~ ~]

12
ren/urb.hoon
View File

@ -2,13 +2,15 @@
:::: /hoon/urb/ren
::
/? 309
/= inner
/+ landscape
/= full-page
/^ manx
/|
/, /web/collections /collections-elem/
/ /!hymn/
/, /web/collections /; landscape /collections-elem/
/web/pages /!hymn/
/ /; landscape /!hymn/
==
::
/: /===/web/404 /!hymn/
/: /===/web/404 /; landscape /!hymn/
==
inner
full-page

39
sec/com/asana.hoon
View File

@ -1,39 +0,0 @@
:: Test url +https://app.asana.com/api/1.0/users/me
::
:::: /hoon/asana/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://app.asana.com/-/oauth_authorize?response_type=code'
++ exchange-url 'https://app.asana.com/-/oauth_token'
--
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~ dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app by logging into https://app.asana.com/, and clicking
:: "My Profile Settings" > Apps > "Manage my developer apps"
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/asana.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 /com/asana
:: Enter this sample command to get your user information:
:: +https://app.asana.com/api/1.0/users/me
:: Before you receive the response, you'll have to clink on the link.
:: If you successfully auth, you should receive the response in the dojo.

38
sec/com/digitalocean.hoon
View File

@ -1,38 +0,0 @@
:: Test url +https://api.digitalocean.com/v2/account
::
:::: /hoon/digitalocean/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://cloud.digitalocean.com/v1/oauth/authorize?response_type=code'
++ exchange-url 'https://cloud.digitalocean.com/v1/oauth/token'
--
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~[%read %write] dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://cloud.digitalocean.com/settings/api/applications/new
:: to get a client id and secret
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/digitalocean.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/digitalocean
:: Enter home this sample command to get your user information:
:: +https://api.digitalocean.com/v2/account
:: Before you receive the response, you'll have to clink on the link.
:: If you successfully auth, you should receive the response in the dojo.

41
sec/com/dropboxapi.hoon
View File

@ -1,41 +0,0 @@
:: Test url +https://api.dropboxapi.com/2/users/get_current_account &json ~
::
:::: /hoon/dropboxapi/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://www.dropbox.com/1/oauth2/authorize?response_type=code'
++ exchange-url 'https://api.dropboxapi.com/1/oauth2/token'
--
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request (out-add-header:aut scope=~ dialog-url)
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://www.dropbox.com/developers-v1/apps to get a
:: client id and secret.
:: Be sure to be on https://localhost:8443 and to have registered
:: 'http://localhost:8443/~/ac/dropboxapi.com/~./in' as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/dropbox
:: Enter this sample command to show your user info:
:: +https://api.dropboxapi.com/2/users/get_current_account &json ~
:: Before you receive the response, you'll have to click on the link in the
:: dojo to authenticate yourself.
:: You should receive a response listing the contents of that directory.

42
sec/com/facebook.hoon
View File

@ -1,42 +0,0 @@
:: Test url +https://graph.facebook.com/v2.5/me
::
:::: /hoon/facebook/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://www.facebook.com/dialog/oauth?response_type=code'
++ exchange-url 'https://graph.facebook.com/v2.3/oauth/access_token'
--
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) access-token/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut
%+ ~(standard oauth2 bal access-token) .
|=(access-token/token:oauth2 +>(access-token access-token))
::
++ filter-request
%^ out-add-query-param:aut 'access_token'
scope=~['user_about_me' 'user_posts']
dialog-url
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
::
++ receive-auth-response
|= a/httr:eyre ^- core-move:aut
?: (bad-response:aut p.a)
[%give a] :: [%redo ~] :: handle 4xx?
=+ `{access-token/@t expires-in/@u}`(grab-expiring-token:aut a)
?. (lth expires-in ^~((div ~d7 ~s1))) :: short-lived token
[[%redo ~] +>.$(access-token access-token)]
:- %send
%^ request-token:aut exchange-url
grant-type='fb_exchange_token'
[key='fb_exchange_token' value=access-token]~
--

10
sec/com/github.hoon
View File

@ -1,10 +0,0 @@
:: Test url +https://api.github.com/user
::
:::: /hoon/github/com/sec
::
/+ basic-auth
::
|_ {bal/(bale:eyre keys:basic-auth) ~}
++ aut ~(standard basic-auth bal ~)
++ filter-request out-adding-header:aut
--

41
sec/com/instagram.hoon
View File

@ -1,41 +0,0 @@
:: Test url +https://api.instagram.com/v1/users/self
::
:::: /hoon/instagram/com/sec
::
/+ oauth2
::
::::
::
|%
++ dialog-url 'https://api.instagram.com/oauth/authorize?response_type=code'
++ exchange-url 'https://api.instagram.com/oauth/access_token'
--
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request
%^ out-add-query-param:aut 'access_token'
scope=~[%basic]
dialog-url
::
++ receive-auth-query-string (in-code-to-token:aut exchange-url)
++ receive-auth-response bak-save-token:aut
--
:: create a developer app on https://www.instagram.com/developer/ to get a
:: client id and secret
:: Be sure to be on https://localhost:8443, and to have registered
:: http://localhost:8443/~/ac/instagram.com/~./in as the redirect URI.
:: (If unable to change port number of ship, change the redirect URI port in %eyre)
:: |init-oauth2 |init-oauth2 /com/instagram
:: Enter this sample command to get your user information:
:: +https://api.instagram.com/v1/users/self
:: Before you receive the response, you'll have to clink on the link to
:: authenicate yourself. You should then receive the response.

21
sec/com/slack.hoon
View File

@ -1,21 +0,0 @@
:: Test url +https://slack.com/api/auth.test
::
:::: /hoon/slack/com/sec
::
/+ oauth2
::
::::
::
|_ {bal/(bale:eyre keys:oauth2) tok/token:oauth2}
:: ++aut is a "standard oauth2" core, which implements the
:: most common handling of oauth2 semantics. see lib/oauth2 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth2 bal tok) . |=(tok/token:oauth2 +>(tok tok)))
++ filter-request
%^ out-add-query-param:aut 'token'
scope=~[%client %admin]
oauth-dialog='https://slack.com/oauth/authorize'
::
++ receive-auth-query-string (in-code-to-token:aut url='https://slack.com/api/oauth.access')
++ receive-auth-response bak-save-token:aut
--

27
sec/com/twitter.hoon
View File

@ -1,27 +0,0 @@
:: Test url +https://api.twitter.com/1.1/account/verify_credentials.json
::
:::: /hoon/twitter/com/sec
::
/+ oauth1
::
::::
::
|_ {bal/(bale:eyre keys:oauth1) tok/token:oauth1}
:: ++aut is a "standard oauth1" core, which implements the
:: most common handling of oauth1 semantics. see lib/oauth1 for more details,
:: and examples at the bottom of the file.
++ aut (~(standard oauth1 bal tok) . |=(tok/token:oauth1 +>(tok tok)))
++ filter-request
%+ out-add-header:aut
token-request='https://api.twitter.com/oauth/request_token'
oauth-dialog='https://api.twitter.com/oauth/authorize'
::
++ filter-response res-handle-request-token:aut
::
++ receive-auth-query-string
%- in-exchange-token:aut
exchange-url='https://api.twitter.com/oauth/access_token'
::
++ receive-auth-response bak-save-token:aut
:: ++ discard-state ~
--

2
sur/asn1.hoon
View File

@ -3,6 +3,7 @@
:: A minimal representation of some basic ASN.1 types,
:: created to support PKCS keys, digests, and cert requests.
::
^?
|%
:: +bespoke:asn1: context-specific, generic ASN.1 tag type
::
@ -65,6 +66,7 @@
:: |obj:asn1: constant object ids, pre-encoded
::
++ obj
^?
|% :: rfc4055
++ sha-256 0x1.0204.0365.0148.8660 :: 2.16.840.1.101.3.4.2.1
++ rsa 0x1.0101.0df7.8648.862a :: 1.2.840.113549.1.1.1

6
sur/down.hoon
View File

@ -1,6 +0,0 @@
::
:::: /hoon/down/sur
::
/? 310
/- markdown
down:markdown

1
sur/hall.hoon
View File

@ -1,6 +1,7 @@
::
:::: /sur/hall/hoon
::
^?
|%
::
::TODO use different words for different kinds of burdens

22
sur/keygen.hoon
View File

@ -1,17 +1,23 @@
|%
+= nodes (map ship node)
+= uodes (map ship uode)
+= revision @ud
+= nodetype tape
+= mnemonic tape
::
+= node [meta=meta seed=@ux keys=wallet]
+= uode [meta=meta seed=@ux keys=edkeys]
+= vault
$: ownership=node
voting=node
management=node
transfer=node
spawn=node
network=uode
==
::
+= meta [typ=tape rev=@ud who=(unit ship)]
+= node [type=nodetype seed=mnemonic keys=wallet]
+= uode [revi=revision seed=@ux keys=edkeys]
::
+= wallet [public=@ux private=@ux chain=@ux]
+= wallet [keys=[public=@ux private=@ux] addr=@ux chain=@ux]
::
+= edkeys [auth=keypair crypt=keypair]
::
+= keypair [public=@ux secret=@ux]
::
+= revisions [transfer=@ud spawn=@ud delegate=@ud manage=@ud network=@ud]
--

1
sur/lens.hoon
View File

@ -1,3 +1,4 @@
^?
|%
++ command
$: source/source

42
sur/markdown.hoon
View File

@ -1,42 +0,0 @@
::
:::: /hoon/markdown/sur
::
/? 310
|%
++ down (list elem)
++ kids (list inline)
++ inline
=+ ^= inlik
$% {$emph p/?} :: strong?
{$delt ~} :: strikethrough
{$link p/tape q/(unit tape)}
{$blot p/tape q/(unit tape)} :: image
==
=+ ^= inlin
$% {$$ p/tape}
{$line ~}
{$code p/tape}
{$htmt p/cord} :: XX (each marx mane)
==
$^({p/inlik q/kids} inlin)
::
::
++ elem $^(tops node)
++ tops :: childful block
$: $= p
$% {$bloq ~}
{$list p/? q/$@(char {p/@u q/char})} :: tight ordered?
{$item ~}
==
q/down
==
++ node :: childless block
$% {$para p/kids}
{$meta p/(map cord cord)} :: front matter
{$hrul ~}
{$head p/@u q/kids}
{$code p/(unit {p/char q/@u r/tape}) q/wain} :: info contents
{$html p/wain}
{$defn ~} :: empty para
==
--

5
sur/sole.hoon
View File

@ -1,7 +1,8 @@
::
:::: /hoon/sole/sur
::
=> |%
^?
|%
++ sole-action :: sole to app
$% :: {$abo ~} :: reset interaction
{$det sole-change} :: command line edit
@ -78,8 +79,6 @@
(unit knot)
hiss:eyre
$-(httr:eyre (sole-request out))
--
|%
:: ::
++ sole-gen :: XX virtual type
$% {$say $-((sole-args) (cask))} :: direct noun

15
sur/tree-include.hoon
View File

@ -1,15 +0,0 @@
::
:::: /hoon/tree-include/sur
::
/? 310
|-
$: mime/mime
body/json
head/json
snip/json
meta/json
sect/json
comt/json
plan/json
bump/knot
==

200
sur/twitter.hoon
View File

@ -1,200 +0,0 @@
|%
++ post {id/@u who/@ta now/@da txt/@t} :: recieved tweet
++ keys :: twitter-key type
$: con/{tok/@t sec/@t} :: user key pair
acc/{tok/@t sec/@t} :: app key pair
==
::
++ command :: poke action
$% {$post p/@uvI q/cord} :: post a tweet
==
++ sur-twit . :: XX
::
++ reqs
|%
++ args
|%
++ dev @t :: device name
++ gat @t :: grant type
++ lat @t :: latitude
++ lid (list tid) :: screen names
++ lon @t :: longitude
++ lsc (list scr) ::
++ nam @t :: location name
++ pla @t :: place-id
++ scr @t :: screen name
++ slu @t :: category name
++ tid @u :: user id
++ tok @t :: oauth token
++ url @t :: callback url
--
++ param
=> args
=< $? de gr id is la lo na os pl qq sc
sd ss sl si st te ti ts ur ui us
==
|%
++ de {$device p/dev}
++ gr {$grant-type p/gat}
++ id {$id p/tid}
++ is {$id p/lid}
++ la {$lat p/lat}
++ lo {$long p/lon}
++ na {$name p/lid}
++ os {$source-screen-name p/scr}
++ pl {$place-id p/pla}
++ qq {$q p/@t}
++ sc {$screen-name p/scr}
++ sd ?(ui sc)
++ ss {$screen-name p/lsc}
++ sl {$slug p/slu}
++ si {$source-id p/tid}
++ st {$status p/@t}
++ te {$text p/@t}
++ ti {$target-id p/tid}
++ ts {$target-screen-name p/scr}
++ ur {$url p/url}
++ ui {$user-id p/tid}
++ us {$user-id p/lid}
--
::
:: the head of every element in ++doc-data is a hoon type for an endpoint
:: ++endpoint is the grand union of all of them
++ endpoint (normalize (fork-clams (heads doc-data)))
++ heads |*(a/(pole) ?~(a a [-<.a (heads +.a)]))
++ fork-clams
=+ $:{a/(pair _{term *} (pole _{term *}))}
|@ ++ $
?~ q.a p.a
?(p.a (fork-clams q.a))
--
::
++ normalize
=+ $:{a/_{@ *}}
|@ ++ $
|= b/*
^+ [?@(- . .)]:(a b)
(a b)
--
::
++ doc-data-dry :: staticly typed for endpoint lookup
=, param
^- (list {typ/_{term (list param)} met/?($get $post) pax/path})
doc-data
::
++ doc-data :: scraped from api docs, used to create types and requests
:: ^- (pole {_{term _(pole *param)} ?($get $post) path})
=> param
:~
[ {$mentions ~} %get /statuses/mentions-timeline ]
[ {$posts-by sd ~} %get /statuses/user-timeline ]
[ {$timeline ~} %get /statuses/home-timeline ]
[ {$retweets-mine ~} %get /statuses/retweets-of-me ]
[ {$retweets-of id ~} %get /statuses/retweets/':id' ]
[ {$show-status id ~} %get /statuses/show ]
[ {$del-status id ~} %post /statuses/destroy/':id' ]
[ {$full-status id ~} %post /statuses/looup ]
[ {$update st ~} %post /statuses/update ]
[ {$retweet id ~} %post /statuses/retweet/':id' ]
[ {$unretweet id ~} %post /statuses/unretweet/':id' ]
::
[ {$oembed-from-id id ~} %get /statuses/oembed ]
[ {$oembed-from-url ur ~} %get /statuses/oembed ]
[ {$retweeters id ~} %get /statuses/retweeters/ids ]
[ {$search qq ~} %get /search/tweets ]
[ {$all-dms ~} %get /direct-messages ]
[ {$all-dms-sent ~} %get /direct-messages/sent ]
[ {$show-dm id ~} %get /direct-messages/show ]
[ {$del-dm id ~} %post /direct-messages/destroy ]
[ {$dm sd te ~} %post /direct-messages/new ]
::
[ {$blocked-retweeters ~} %get /friendships/no-retweets/ids ]
[ {$followers sd ~} %get /followers/list ]
[ {$follower-ids sd ~} %get /followers/ids ]
[ {$friends sd ~} %get /friends/list ]
[ {$friend-ids sd ~} %get /friends/ids ]
[ {$friend-requests ~} %get /friendships/incoming ]
[ {$friend-requesting ~} %get /friendships/outgoing ]
[ {$follow sd ~} %post /friendships/create ]
[ {$unfollow sd ~} %post /friendships/destroy ]
[ {$set-friendship sd ~} %post /friendships/update ]
[ {$relationships ?(us ss) ~} %get /friendships/lookup ]
:- {$relationship ?(si os) ?(ti ts) ~}
[%get /friendships/show]
::
[ {$show-settings ~} %get /account/settings ]
[ {$test-login ~} %get /account/verify-credentials ]
[ {$set-settings ~} %post /account/settings ]
[ {$set-sms-target de ~} %post /account/update-delivery-device ]
[ {$set-profile ~} %post /account/update-profile ]
[ {$set-colors ~} %post /account/update-profile-colors ]
[ {$del-background ~} %post /account/remove-profile-banner ]
:- {$set-background ~}
[%post /account/update-profile-background-image]
::
[ {$blocks ~} %get /blocks/list ]
[ {$blocks-ids ~} %get /blocks/ids ]
[ {$block sd ~} %post /blocks/create ]
[ {$unblock sd ~} %post /blocks/destroy ]
::
[ {$full-users ?(us ss) ~} %get /users/lookup ]
[ {$user sd ~} %get /users/show ]
[ {$search-users qq ~} %get /users/search ]
[ {$user-contributees sd ~} %get /users/contributees ] :: undoc'd
[ {$user-contributors sd ~} %get /users/contributors ] :: undoc'd
[ {$user-prof sd ~} %get /users/profile-banner ]
::
[ {$mute-user sd ~} %post /mutes/users/create ]
[ {$unmute-user sd ~} %post /mutes/users/destroy ]
[ {$muted ~} %get /mutes/users/list ]
[ {$muted-ids ~} %get /mutes/users/ids ]
::
[ {$suggested ~} %get /users/suggestions ]
[ {$suggestion sl ~} %get /users/suggestions/':slug' ]
:- {$suggestion-posts sl ~}
[%get /users/suggestions/':slug'/members]
::
[ {$favorites ~} %get /favorites/list ]
[ {$del-favorite id ~} %post /favorites/destroy ]
[ {$favorite id ~} %post /favorites/create ]
::
[ {$lists ~} %get /lists/list ]
[ {$lists-of sd ~} %get /lists/memberships ]
[ {$lists-by sd ~} %get /lists/ownerships ]
[ {$lists-subscribed sd ~} %get /lists/subscriptions ]
[ {$list ~} %get /lists/show ]
[ {$list-posts ~} %get /lists/statuses ]
[ {$list-remove ?(us ss) ~} %post /lists/members/destroy-all ]
[ {$list-subscribers ~} %get /lists/subscribers ]
[ {$list-subscribe ~} %post /lists/subscribers/create ]
[ {$list-unsubscribe ~} %post /lists/subscribers/destroy ]
[ {$list-is-subscribed sd ~} %get /lists/subscribers/show ]
[ {$list-add ?(us ss) ~} %post /lists/members/create-all ]
[ {$list-is-in sd ~} %get /lists/members/show ]
[ {$list-members ~} %get /lists/members ]
[ {$del-list ~} %post /lists/destroy ]
[ {$config-list ~} %post /lists/update ]
[ {$new-list na ~} %post /lists/create ]
::
[ {$saved-searches ~} %get /saved-searches/list ]
[ {$full-saved-search id ~} %get /saved-searches/show/':id' ]
[ {$save-search qq ~} %post /saved-searches/create ]
[ {$del-saved-search id ~} %post /saved-searches/destroy/':id' ]
::
[ {$full-geo id ~} %get /geo/id/':id' ]
[ {$geo-reverse la lo ~} %get /geo/reverse-geocode ]
[ {$search-geo ~} %get /geo/search ]
[ {$geo-similar la lo na ~} %get /geo/similar-places ]
[ {$trend-locations ~} %get /trends/available ]
[ {$trends-at id ~} %get /trends/place ]
[ {$trends-near la lo ~} %get /trends/closest ]
::
[ {$user-report sd ~} %post /users/report-spam ]
[ {$help-config ~} %get /help/configuration ]
[ {$help-langs ~} %get /help/languages ]
[ {$help-privacy ~} %get /help/privacy ]
[ {$help-tos ~} %get /help/tos ]
[ {$rate-limit-info ~} %get /application/rate-limit-status ]
==
--
--

150
sur/unicode-data.hoon
View File

@ -1,150 +0,0 @@
|%
:: # %unicode-data
:: types to represent UnicdoeData.txt.
+| %unicode-data
++ line
:: an individual codepoint definition
::
$: code=@c :: codepoint in hexadecimal format
name=tape :: character name
gen=general :: type of character this is
:: canonical combining class for ordering algorithms
can=@ud
bi=bidi :: bidirectional category of this character
de=decomp :: character decomposition mapping
:: todo: decimal/digit/numeric need to be parsed.
decimal=tape :: decimal digit value (or ~)
digit=tape :: digit value, covering non decimal radix forms
numeric=tape :: numeric value, including fractions
mirrored=? :: whether char is mirrored in bidirectional text
old-name=tape :: unicode 1.0 compatibility name
iso=tape :: iso 10646 comment field
up=(unit @c) :: uppercase mapping codepoint
low=(unit @c) :: lowercase mapping codepoint
title=(unit @c) :: titlecase mapping codepoint
==
::
++ general
:: one of the normative or informative unicode general categories
::
:: these abbreviations are as found in the unicode standard, except
:: lowercased as to be valid symbols.
$? $lu :: letter, uppercase
$ll :: letter, lowercase
$lt :: letter, titlecase
$mn :: mark, non-spacing
$mc :: mark, spacing combining
$me :: mark, enclosing
$nd :: number, decimal digit
$nl :: number, letter
$no :: number, other
$zs :: separator, space
$zl :: separator, line
$zp :: separator, paragraph
$cc :: other, control
$cf :: other, format
$cs :: other, surrogate
$co :: other, private use
$cn :: other, not assigned
::
$lm :: letter, modifier
$lo :: letter, other
$pc :: punctuation, connector
$pd :: punctuation, dash
$ps :: punctuation, open
$pe :: punctuation, close
$pi :: punctuation, initial quote
$pf :: punctuation, final quote
$po :: punctuation, other
$sm :: symbol, math
$sc :: symbol, currency
$sk :: symbol, modifier
$so :: symbol, other
==
::
++ bidi
:: bidirectional category of a unicode character
$? $l :: left-to-right
$lre :: left-to-right embedding
$lri :: left-to-right isolate
$lro :: left-to-right override
$fsi :: first strong isolate
$r :: right-to-left
$al :: right-to-left arabic
$rle :: right-to-left embedding
$rli :: right-to-left isolate
$rlo :: right-to-left override
$pdf :: pop directional format
$pdi :: pop directional isolate
$en :: european number
$es :: european number separator
$et :: european number terminator
$an :: arabic number
$cs :: common number separator
$nsm :: non-spacing mark
$bn :: boundary neutral
$b :: paragraph separator
$s :: segment separator
$ws :: whitespace
$on :: other neutrals
==
::
++ decomp
:: character decomposition mapping.
::
:: tag: type of decomposition.
:: c: a list of codepoints this decomposes into.
(unit {tag/(unit decomp-tag) c/(list @c)})
::
++ decomp-tag
:: tag that describes the type of a character decomposition.
$? $font :: a font variant
$nobreak :: a no-break version of a space or hyphen
$initial :: an initial presentation form (arabic)
$medial :: a medial presentation form (arabic)
$final :: a final presentation form (arabic)
$isolated :: an isolated presentation form (arabic)
$circle :: an encircled form
$super :: a superscript form
$sub :: a subscript form
$vertical :: a vertical layout presentation form
$wide :: a wide (or zenkaku) compatibility character
$narrow :: a narrow (or hankaku) compatibility character
$small :: a small variant form (cns compatibility)
$square :: a cjk squared font variant
$fraction :: a vulgar fraction form
$compat :: otherwise unspecified compatibility character
==
::
:: #
:: # %case-map
:: #
:: types to represent fast lookups of case data
+| %case-map
++ case-offset
:: case offsets can be in either direction
$% :: add {a} to get the new character
[%add a=@u]
:: subtract {a} to get the new character
[%sub s=@u]
:: take no action; return self
[%none ~]
:: represents series of alternating uppercase/lowercase characters
[%uplo ~]
==
::
++ case-node
:: a node in a case-tree.
::
:: represents a range of
$: start=@ux
end=@ux
upper=case-offset
lower=case-offset
title=case-offset
==
::
++ case-tree
:: a binary search tree of ++case-node items, sorted on span.
(tree case-node)
--

683
sys/arvo.hoon
View File

@ -1,10 +1,21 @@
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: Postface ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
=> +7
~> %slog.[0 leaf+"%arvo-assembly"]
=- ~> %slog.[0 leaf+"%arvo-assembled"]
-
=< ::
:: Arvo formal interface
::
:: this lifecycle wrapper makes the arvo door (multi-armed core)
:: look like a gate (function or single-armed core), to fit
:: urbit's formal lifecycle function. a practical interpreter
:: can ignore it.
::
|= [now=@da ovo=*]
^- *
~> %slog.[0 leaf+"arvo-event"]
.(+> +:(poke now ovo))
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: volume 3, Arvo models and skeleton ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
@ -61,6 +72,8 @@
++ ovum {p/wire q/curd} :: typeless ovum
++ pane (list {p/@tas q/vase}) :: kernel modules
++ pone (list {p/@tas q/vise}) :: kernel modules old
+$ scry-sample
[fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
++ ship @p :: network identity
++ sink (trel bone ship path) :: subscription
++ sley $- {* (unit (set monk)) term beam} :: namespace function
@ -68,6 +81,7 @@
++ slyd $- {* (unit (set monk)) term beam} :: super advanced
(unit (unit (cask))) ::
++ slyt $-({* *} (unit (unit))) :: old namespace
+$ vane [=vase =worm]
++ vile :: reflexive constants
$: typ/type :: -:!>(*type)
duc/type :: -:!>(*duct)
@ -89,32 +103,65 @@
:: section 3bE, Arvo core ::
::
++ sloy
:: +sloy: adapter from old style scrys to new style scrys
::
:: This does path parsing which shows up hot, but removing the last +slay
:: here requires deeper interface changes.
::
!:
~/ %sloy
|= sod/slyd
^- slyt
|= {ref/* raw/*}
=+ pux=((soft path) raw)
?~ pux ~
?. ?=({@ @ @ @ *} u.pux) ~
=+ :* hyr=(slay i.u.pux)
fal=(slay i.t.u.pux)
dyc=(slay i.t.t.u.pux)
=+ :* hyr=(slaw %tas i.u.pux)
fal=(slaw %p i.t.u.pux)
dyc=(slaw %tas i.t.t.u.pux)
ved=(slay i.t.t.t.u.pux)
tyl=t.t.t.t.u.pux
==
?. ?=({$~ $$ $tas @} hyr) ~
?. ?=({$~ $$ $p @} fal) ~
?. ?=({$~ $$ $tas @} dyc) ~
?~ hyr ~
?~ fal ~
?~ dyc ~
?. ?=(^ ved) ~
=+ ron=q.p.u.hyr
=+ bed=[[q.p.u.fal q.p.u.dyc (case p.u.ved)] (flop tyl)]
=/ ron=@tas u.hyr
=+ bed=[[u.fal u.dyc (case p.u.ved)] (flop tyl)]
=+ bop=(sod ref ~ ron bed)
?~ bop ~
?~ u.bop [~ ~]
[~ ~ +.q.u.u.bop]
:: +sloy-light: minimal parsing version of sloy
::
:: There are several places inside vanes where we manually call the scry
:: function raw, instead of passing it into +mink. In those cases, we're
:: paying the price to render the arguments as text, and then are
:: immediately parsing the passed in data. We can avoid that.
::
:: TODO: The entire scrying system needs to be cleaned up in a more
:: permanent way. This hack fixes up some print/parse costs, but doesn't
:: recover the print/parse costs of the scry itself, which we could prevent
:: if we didn't send (list @ta), but instead sent (list dime).
::
++ sloy-light
~/ %sloy-light
|= sod/slyd
|= [ref=* ron=@tas fal=@p dyc=@tas ved=case tyl=path]
:: we do not flop tyl because tyl wouldn't have been flopped by +en-beam
::
=+ bed=[[fal dyc ved] tyl]
=+ bop=(sod ref ~ ron bed)
?~ bop ~
?~ u.bop [~ ~]
[~ ~ +.q.u.u.bop]
::
++ symp :: symbol or empty
|= a=* ^- @tas
?.(&(?=(@ a) ((sane %tas) a)) %$ a)
::
++ vent :: vane core
|= {lal/@tas vil/vile bud/vase sew/(pair worm vase)}
|= [who=ship lal=@tas vil=vile bud=vase =vane]
~% %vent +>+ ~
|%
++ ruck :: update vase
@ -123,23 +170,52 @@
=- ?:(?=(%| -.res) ((slog p.res) +>.$) p.res)
^= res %- mule |.
=+ arg=[~2000.1.1 0 =>(~ |~(* ~))]
=+ rig=(slym q.sew arg)
=+ rig=(slym vase.vane arg)
=+ gen=(rain pax txt)
=+ rev=(slym (slap bud gen) bud)
=+ syg=(slym rev arg)
:: update the vane itself
::
:: We don't cache the +slap/+slam types because they're only used once
:: right here; they'll never be used again.
::
=. vase.vane
~| %load-lost
+>.^$(q.sew (slam (slap syg [%limb %load]) (slap rig [%limb %stay])))
(slam (slap syg [%limb %load]) (slap rig [%limb %stay]))
:: prime the new compiler cache
::
prime
:: reset and prime the worm cache for scrys
::
:: If the +slap/+slym in scry isn't cached, we spend the majority of
:: the time in a scry in the compiler. The +scry gate cannot have side
:: effects so we can't modify the cache at access time. So we seed the
:: cache with all the things +scry will need when we install the vane
::
++ prime
^+ ..prime
::
%_ ..prime
worm.vane
:: reset cache and add in vane activation entry
::
=^ rig worm.vane
(~(slym wa *worm) vase.vane *[@p @da @ slyd])
:: cache the access of the %scry arm
::
=^ fun worm.vane (~(slap wa worm.vane) rig [%limb %scry])
:: cache the call to +mint that the +slym in +scry will do
::
+:(~(mint wa worm.vane) p.fun [%limb %$])
==
::
++ wink :: deploy
|= {now/@da eny/@ ski/slyd}
=+ rig=(slym q.sew +<) :: activate vane
=^ rig worm.vane
~| [%failed-vane-activation-for lal]
(~(slym wa worm.vane) vase.vane [who +<]) :: activate vane
~% %wink +>+> ~
|%
++ doze
|= {now/@da hen/duct}
^- (unit @da)
((hard (unit @da)) q:(slym (slap rig [%limb %doze]) +<))
::
++ slid
|= {hed/mill tal/mill}
^- mill
@ -158,13 +234,19 @@
++ slur :: call gate on
|= {gat/vase hil/mill}
^- (unit (pair vase worm))
=+ sam=(slot 6 gat)
=+ ^= hig
=^ sam worm.vane
~| [%failed-slot-in lal]
(~(slot wa worm.vane) 6 gat)
=^ hig worm.vane
~| [%failed-nest-in lal]
?- -.hil
%& (~(nest wa p.sew) p.sam p.p.hil)
%| (~(nets wa p.sew) p.sam p.p.hil)
%& (~(nest wa worm.vane) p.sam p.p.hil)
%| (~(nets wa worm.vane) p.sam p.p.hil)
==
?.(-.hig ~ `[(slym gat +>.hil) +.hig])
?. hig
~
~| [%failed-slym-in lal]
`(~(slym wa worm.vane) gat +>.hil)
::
++ slur-a ~/(%slur-a |=({gat/vase hil/mill} =+(%a (slur gat hil))))
++ slur-b ~/(%slur-b |=({gat/vase hil/mill} =+(%b (slur gat hil))))
@ -196,20 +278,20 @@
~/ %song ::
|= mex/vase :: mex: vase of card
^- (unit (pair mill worm)) ::
=^ hip p.sew (~(nell wa p.sew) p.mex) ::
=^ hip worm.vane (~(nell wa worm.vane) p.mex) ::
?. hip ~ :: a card is a cell
?. ?=($meta -.q.mex) `[[%& mex] p.sew] :: ordinary card
=^ tiv p.sew (~(slot wa p.sew) 3 mex) ::
=^ hip p.sew (~(nell wa p.sew) p.tiv) ::
?. ?=($meta -.q.mex) `[[%& mex] worm.vane] :: ordinary card
=^ tiv worm.vane (~(slot wa worm.vane) 3 mex) ::
=^ hip worm.vane (~(nell wa worm.vane) p.tiv) ::
?. hip ~ :: a vase is a cell
=^ vax p.sew (~(slot wa p.sew) 2 tiv) ::
=^ hip p.sew (~(nest wa p.sew) typ.vil p.vax) ::
=^ vax worm.vane (~(slot wa worm.vane) 2 tiv) ::
=^ hip worm.vane (~(nest wa worm.vane) typ.vil p.vax) ::
?. hip ~ :: vase head is type
%+ biff ::
=+ mut=(milt q.tiv) :: card type, value
|- ^- (unit (pair milt worm)) ::
?. ?=({$meta p/* q/milt} q.mut) `[mut p.sew] :: ordinary metacard
=^ hip p.sew (~(nets wa p.sew) mev.vil p.mut)::
?. ?=({$meta p/* q/milt} q.mut) `[mut worm.vane] :: ordinary metacard
=^ hip worm.vane (~(nets wa worm.vane) mev.vil p.mut)::
?. hip ~ :: meta-metacard
$(mut +.q.mut) :: descend into meta
|=(a/(pair milt worm) `[[%| p.a] q.a]) :: milt to mill
@ -226,8 +308,8 @@
%& (some p.har)
==
^= har ^- (each (pair arvo worm) term)
=^ caq p.sew (~(spot wa p.sew) 3 wec)
?+ q.caq [%| (cat 3 %funk (@tas q.caq))]
=^ caq worm.vane (~(spot wa worm.vane) 3 wec)
?+ q.caq [%| (cat 3 %funk (symp q.caq))]
::
{$pass p/* q/@tas r/{p/@tas q/*}}
%- (bond |.([%| p.r.q.caq]))
@ -236,14 +318,14 @@
?. ((sane %tas) lal) ~
%+ biff ((soft path) p.q.caq)
|= pax/path
=^ yav p.sew (~(spot wa p.sew) 15 caq)
=^ yav worm.vane (~(spot wa worm.vane) 15 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%pass pax lal hil] vel]
::
{$give p/{p/@tas q/*}}
%- (bond |.([%| p.p.q.caq]))
=^ yav p.sew (~(spot wa p.sew) 3 caq)
=^ yav worm.vane (~(spot wa worm.vane) 3 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%give hil] vel]
@ -253,7 +335,7 @@
%+ biff ((soft @) p.q.caq)
|= lal/@tas
?. ((sane %tas) lal) ~
=^ yav p.sew (~(spot wa p.sew) 7 caq)
=^ yav worm.vane (~(spot wa worm.vane) 7 caq)
%+ bind (song yav)
|= {hil/mill vel/worm}
[%& [%slip lal hil] vel]
@ -263,12 +345,12 @@
++ said :: vase to (list move)
|= vud/vase
|- ^- (pair (list move) worm)
?: =(~ q.vud) [~ p.sew]
=^ hed p.sew (~(slot wa p.sew) 2 vud)
=^ tal p.sew (~(slot wa p.sew) 3 vud)
=^ mov p.sew (need (sump hed))
=^ moz p.sew $(vud tal)
[[mov moz] p.sew]
?: =(~ q.vud) [~ worm.vane]
=^ hed worm.vane (~(slot wa worm.vane) 2 vud)
=^ tal worm.vane (~(slot wa worm.vane) 3 vud)
=^ mov worm.vane (need (sump hed))
=^ moz worm.vane $(vud tal)
[[mov moz] worm.vane]
::
++ scry :: read namespace
~/ %scry
@ -278,7 +360,7 @@
==
^- (unit (unit (cask)))
:: ~& [%arvo-scry ren bed]
=+ ^= old
=/ old=scry-sample
:* fur
ren
[%& p.bed]
@ -287,18 +369,19 @@
(flop s.bed)
==
^- (unit (unit (cask)))
=+ pro=(slym (slap rig [%limb %scry]) old)
=+ fun=-:(~(slap wa worm.vane) rig [%limb %scry])
=+ pro=-:(~(slym wa worm.vane) fun old)
?~ q.pro ~
?~ +.q.pro [~ ~]
=+ dat=(slot 7 pro)
[~ ~ (mark -.q.dat) +.q.dat]
=/ dat +>.q.pro
[~ ~ (mark -.dat) +.dat]
::
++ soar :: scrub vane
|= sev/vase
^- vase
?: &(=(-.q.q.sew -.q.sev) =(+>.q.q.sew +>.q.sev))
q.sew :: unchanged, use old
sev(+<.q [*@da *@ =>(~ |~(* ~))]) :: clear to stop leak
?: &(=(-.q.vase.vane -.q.sev) =(+>.q.vase.vane +>.q.sev))
vase.vane :: unchanged, use old
sev(+<.q [*@p *@da *@ =>(~ |~(* ~))]) :: clear to stop leak
::
++ swim
~/ %swim
@ -307,16 +390,17 @@
hen/duct
hil/mill
==
^- {{p/(list move) q/worm} q/vase}
:: ~& [%swim-wyt `@ud`~(wyt in p.sew)]
^- [(list move) _vane]
~| [%failed-swim lal org pux]
:: ~& [%swim-wyt `@ud`~(wyt in worm.vane)]
=+ ^= pru
?~ pux
~| [%swim-call-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) rig [%limb %call])
=^ vax worm.vane (~(slap wa worm.vane) rig [%limb %call])
%^ slur-pro lal vax
(slid [%& duc.vil hen] (slix hil))
~| [%swim-take-vane lal ({term $~} +.p.hil)]
=^ vax p.sew (~(slap wa p.sew) rig [%limb %take])
=^ vax worm.vane (~(slap wa worm.vane) rig [%limb %take])
%^ slur-pro lal vax
;: slid
[%& pah.vil u.pux]
@ -324,24 +408,32 @@
(slix (slid [%& [%atom %tas `org] org] hil))
==
?~ pru
~& [%swim-lost lal (@tas +>-.hil)]
[[~ p.sew] q.sew]
=^ pro p.sew (need pru)
=^ moz p.sew (~(slap wa p.sew) pro [%limb %p])
=^ vem p.sew (~(slap wa p.sew) pro [%limb %q])
[(said moz) (soar vem)]
~& [%swim-lost lal (symp +>-.hil)]
[~ [vase.vane worm.vane]]
=^ pro worm.vane (need pru)
=^ moz worm.vane (~(slot wa worm.vane) 2 pro)
=^ vem worm.vane (~(slot wa worm.vane) 3 pro)
=^ sad worm.vane (said moz)
[sad [(soar vem) worm.vane]]
--
--
::
++ vint :: create vane
|= {lal/@tas vil/vile bud/vase pax/path txt/@ta} ::
|= $: who=ship
lal=@tas
vil=vile
bud=vase
pax=path
txt=@ta
==
=- ?:(?=(%| -.res) ((slog p.res) ~) (some p.res))
^= res %- mule |.
~| [%failed-vint lal]
=+ gen=(rain pax txt)
~& [%vane-parsed `@p`(mug gen)]
=+ pro=(vent lal vil bud *worm (slym (slap bud gen) bud))
=+ pro=(vent who lal vil bud [(slym (slap bud gen) bud) *worm])
~& [%vane-compiled `@p`(mug pro)]
pro
prime:pro
::
++ viol :: vane tools
|= but/type
@ -354,7 +446,7 @@
==
::
++ is :: operate in time
|= {vil/vile eny/@ bud/vase niz/(pair worm (list {p/@tas q/vase}))}
|= [who=ship vil=vile eny=@ bud=vase vanes=(list [label=@tas =vane])]
|_ now/@da
++ beck
^- slyd
@ -364,14 +456,15 @@
=+ lal=(end 3 1 ron)
=+ ren=(@t (rsh 3 1 ron))
|- ^- (unit (unit (cask)))
?~ q.niz ~
?. =(lal p.i.q.niz) $(q.niz t.q.niz)
%- scry:(wink:(vent lal vil bud p.niz q.i.q.niz) now (shax now) ..^$)
?~ vanes ~
?. =(lal label.i.vanes) $(vanes t.vanes)
~| [%failed-scry ron bed]
%- scry:(wink:(vent who lal vil bud vane.i.vanes) now eny ..^$)
[fur ren bed]
::
++ dink :: vase by char
|= din/@tas ^- vase
?~(q.niz !! ?:(=(din p.i.q.niz) q.i.q.niz $(q.niz t.q.niz)))
?~(vanes !! ?:(=(din label.i.vanes) vase.vane.i.vanes $(vanes t.vanes)))
::
++ dint :: input routing
|= hap/path ^- @tas
@ -385,15 +478,11 @@
{@ $behn *} %b
==
::
++ doos :: sleep until
|= hap/path ^- (unit @da)
=+ lal=(dint hap)
(doze:(wink:(vent lal vil bud p.niz (dink lal)) now 0 beck) now [hap ~])
::
++ hurl :: start loop
|= {lac/? ovo/ovum}
~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo]
^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
:: ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
^- {p/(list ovum) q=(list [label=@tas =vane])}
?> ?=(^ p.ovo)
%+ kick lac
:~ :* i.p.ovo
@ -407,28 +496,32 @@
==
::
++ race :: take
|= {org/@tas lal/@tas pux/(unit wire) hen/duct hil/mill ves/vase}
^- {p/{p/(list move) q/worm} q/vase}
=+ ven=(vent lal vil bud [p.niz ves])
=+ win=(wink:ven now (shax now) beck)
|= {org/@tas lal/@tas pux/(unit wire) hen/duct hil/mill =vane}
^- [p=(list move) q=_vane]
=+ ven=(vent who lal vil bud vane)
~| [%failed-take lal]
=+ win=(wink:ven now eny beck)
(swim:win org pux hen hil)
::
++ fire :: execute
|= {org/term lal/term pux/(unit wire) hen/duct hil/mill}
^- {{p/(list ovum) q/(list muse)} _vanes}
?: &(?=(^ pux) ?=($~ hen))
[[[[lal u.pux] (curd +>.hil)]~ ~] niz]
=+ naf=q.niz
|- ^- {{p/(list ovum) q/(list muse)} _niz}
?~ naf [[~ ~] [p.niz ~]]
?. =(lal p.i.naf)
[[[[lal u.pux] (curd +>.hil)]~ ~] vanes]
=+ naf=vanes
|- ^- {{p/(list ovum) q/(list muse)} _vanes}
?~ naf [[~ ~] ~]
?. =(lal label.i.naf)
=+ tuh=$(naf t.naf)
[-.tuh [+<.tuh [i.naf +>.tuh]]]
=+ fiq=(race org lal pux hen hil q.i.naf)
[[~ (turn p.p.fiq |=(a/move [lal a]))] [q.p.fiq [[p.i.naf q.fiq] t.naf]]]
::
=+ fiq=(race org lal pux hen hil vane.i.naf)
[[~ (turn p.fiq |=(a/move [lal a]))] [[label.i.naf q.fiq] t.naf]]
::
++ jack :: dispatch card
|= {lac/? gum/muse}
^- {{p/(list ovum) q/(list muse)} _niz}
^- {{p/(list ovum) q/(list muse)} _vanes}
~| %failed-jack
:: =. lac |(lac ?=(?(%g %f) p.gum))
:: =. lac &(lac !?=($b p.gum))
%+ fire
@ -437,175 +530,348 @@
$pass
~? &(!lac !=(%$ p.gum))
:^ %pass [p.gum p.q.r.gum]
[(@tas +>-.q.q.r.gum) p.r.gum]
[(symp +>-.q.q.r.gum) p.r.gum]
q.gum
[p.q.r.gum ~ [[p.gum p.r.gum] q.gum] q.q.r.gum]
::
$give
?> ?=(^ q.gum)
?. ?=(^ i.q.gum)
~& [%jack-bad-duct q.gum]
~& [%jack-bad-card +>-.p.r.gum]
?. &(?=(^ q.gum) ?=(^ i.q.gum))
~| [%jack-bad-duct q.gum]
~| [%jack-bad-card p.gum (symp +>-.p.r.gum)]
!!
~? &(!lac |(!=(%blit +>-.p.r.gum) !=(%d p.gum)))
[%give p.gum (@tas +>-.p.r.gum) `duct`q.gum]
[%give p.gum (symp +>-.p.r.gum) `duct`q.gum]
[i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum]
::
$slip
~? !lac [%slip p.gum (@tas +>-.q.p.r.gum) q.gum]
~? !lac [%slip p.gum (symp +>-.q.p.r.gum) q.gum]
[p.p.r.gum ~ q.gum q.p.r.gum]
==
::
++ kick :: new main loop
|= {lac/? mor/(list muse)}
=| ova/(list ovum)
|- ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))}
?~ mor [(flop ova) niz]
=^ nyx niz (jack lac i.mor)
|- ^- {p/(list ovum) q=(list [label=@tas =vane])}
?~ mor [(flop ova) vanes]
=^ nyx vanes (jack lac i.mor)
$(ova (weld p.nyx ova), mor (weld q.nyx t.mor))
--
--
=+ pit=`vase`!>(.) ::
=+ bud=pit :: becomes tang
:: =+ vil=(viol p.bud) :: cached reflexives
=+ vil=(viol p.bud) :: cached reflexives
=| $: lac/? :: laconic bit
eny/@ :: entropy
niz/(pair worm (list {p/@tas q/vase})) :: modules
=< :: Arvo larval stage
::
:: The true Arvo kernel knows who it is. It should not *maybe*
:: have an identity, nor should it contain multitudes. This outer
:: kernel exists to accumulate identity, entropy, and the
:: standard library. Upon having done so, it upgrades itself into
:: the true Arvo kernel. Subsequent upgrades will fall through
:: the larval stage directly into the actual kernel.
::
:: For convenience, this larval stage also supports hoon compilation
:: with +wish and vane installation with the %veer event.
::
=/ pit=vase !>(..is)
=| $: :: who: our identity once we know it
:: eny: entropy once we learn it
:: bod: %zuse once we receive it
::
who=(unit ship)
eny=(unit @)
bod=(unit vase)
==
:: larval Arvo structural interface
::
|%
++ come ^come :: 22
++ load ^load :: 46
++ peek |=(* ~) :: 47
::
++ poke |= * :: 10
^- [(list ovum) *]
=> .(+< ((hard ,[now=@da ovo=ovum]) +<))
^- [(list ovum) *]
=. +>.$
?+ -.q.ovo
:: ignore unrecognized
::
~& [%larval-ignore p.ovo -.q.ovo]
+>.$
:: install %zuse or vane
::
%veer
^+ +>.$
:: use the maximum comet if we don't know who we are yet
::
=/ our
?^ who
u.who
=/ fip=ship (dec (bex 128))
~>(%slog.[0 leaf+"arvo: larval identity {(scow %p fip)}"] fip)
=. ..veer (veer our now q.ovo)
+>.$(bod ?^(bod bod `bud.^poke))
:: add entropy
::
%wack
^+ +>.$
?> ?=(@ q.q.ovo)
+>.$(eny `q.q.ovo)
:: become who you were born to be
::
%whom
^+ +>.$
?> ?=(@ q.q.ovo)
+>.$(who `q.q.ovo)
==
:: upgrade once we've accumulated identity, entropy, and %zuse
::
?. &(?=(^ who) ?=(^ eny) ?=(^ bod))
[~ +>.$]
~> %slog.[0 leaf+"arvo: metamorphosis"]
=/ nyf
(turn vanes.^poke |=([label=@tas =vane] [label vase.vane]))
(load u.who now u.eny ova=~ u.bod nyf)
::
++ wish |= txt=* :: 4
?> ?=(@ txt)
q:(slap ?~(bod pit u.bod) (ream txt))
--
::
:: persistent arvo state
::
=/ pit=vase !>(..is) ::
=/ vil=vile (viol p.pit) :: cached reflexives
=| $: lac=? :: laconic bit
eny=@ :: entropy
our=ship :: identity
bud=vase :: %zuse
vanes=(list [label=@tas =vane]) :: modules
== ::
=< |%
++ come |= {@ (list ovum) pone} :: 11
=< :: Arvo structural interface
::
|%
++ come |= {@ @ @ (list ovum) vise pone} :: 22
^- {(list ovum) _+>}
~& %hoon-come
=^ rey +>+ (^come +<)
[rey +>.$]
++ keep |=(* (^keep ((hard {@da path}) +<))) :: 4
++ load |= {@ (list ovum) pane} :: 86
::
++ load |= {@ @ @ (list ovum) vase pane} :: 46
^- {(list ovum) _+>}
~& %hoon-load
=^ rey +>+ (^load +<)
[rey +>.$]
++ peek |=(* (^peek ((hard {@da path}) +<))) :: 87
++ poke |= * :: 42
^- {(list ovum) *}
=> .(+< ((hard {now/@da ovo/ovum}) +<))
?: =(%verb -.q.ovo)
[~ +>.$(lac !lac)]
?: ?=($veer -.q.ovo)
[~ +>.$(+ (veer now q.ovo))]
=^ ova +>+ (^poke now ovo)
|- ^- {(list ovum) *}
::
++ peek |=(* (^peek ((hard {@da path}) +<))) :: 47
::
++ poke |= * :: 10
^- [(list ovum) *]
=> .(+< ((hard ,[now=@da ovo=ovum]) +<))
=^ ova +>+.$ (^poke now ovo)
|- ^- [(list ovum) *]
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>+.^$ (veer now q.i.ova))
?: ?=($vega -.q.i.ova)
:: upgrade the kernel
::
?: ?=(%vega -.q.i.ova)
%+ fall
(vega now t.ova (path +<.q.i.ova) (path +>.q.i.ova))
(vega now t.ova ({@ @} +.q.i.ova))
[~ +>.^$]
?: ?=($mass -.q.i.ova)
=+ avo=$(ova t.ova)
:_ +.avo
:_ -.avo
%= i.ova
q.q
:- %userspace
:- %|
:~ hoon+`pit
zuse+`bud
hoon-cache+`p.niz
q.q.i.ova
dot+`.
==
==
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
++ wish |=(* (^wish ((hard @ta) +<))) :: 20
:: iterate over effects, handling those on arvo proper
:: and passing the rest through as output
::
=^ vov +>+.^$ (feck now i.ova)
?~ vov
$(ova t.ova)
=/ avo $(ova t.ova)
[[+.vov -.avo] +.avo]
::
++ wish |=(* (^wish ((hard @ta) +<))) :: 4
--
:: Arvo implementation core
::
|%
++ come :: load incompatible
|= {yen/@ ova/(list ovum) nyf/pone}
|= [who=ship now=@da yen=@ ova=(list ovum) dub=vise nyf=pone]
^+ [ova +>]
(load yen ova (turn nyf |=({a/@tas b/vise} [a (slim b)])))
::
++ keep :: wakeup delay
|= {now/@da hap/path}
=> .(+< ((hard {now/@da hap/path}) +<))
(~(doos (is vil eny bud niz) now) hap)
=/ fyn (turn nyf |=([a=@tas b=vise] [a (slim b)]))
(load who now yen ova (slim dub) fyn)
::
++ load :: load compatible
|= {yen/@ ova/(list ovum) nyf/pane}
|= [who=ship now=@da yen=@ ova=(list ovum) dub=vase nyf=pane]
^+ [ova +>]
=: eny yen
q.niz nyf
=: our who
eny yen
bud dub
vanes (turn nyf |=({a/@tas b/vise} [a [b *worm]]))
==
|- ^+ [ova +>.^$]
|- ^- [(list ovum) _+>.^$]
?~ ova
[~ +>.^$]
?: ?=($verb -.q.i.ova)
$(ova t.ova, lac !lac)
?: ?=($veer -.q.i.ova)
$(ova t.ova, +>.^$ (veer *@da q.i.ova))
=+(avo=$(ova t.ova) [[i.ova -.avo] +.avo])
:: iterate over effects, handling those on arvo proper
:: and passing the rest through as output
::
:: In practice, the pending effects after an upgrade
:: are the %veer moves to install %zuse and the vanes.
::
=^ vov +>.^$ (feck now i.ova)
?~ vov
$(ova t.ova)
=/ avo $(ova t.ova)
[[+.vov -.avo] +.avo]
::
++ peek :: external inspect
|= {now/@da hap/path}
^- (unit)
?~ hap [~ hoon-version]
=+ rob=((sloy ~(beck (is vil eny bud niz) now)) [151 %noun] hap)
=+ rob=((sloy ~(beck (is our vil eny bud vanes) now)) [151 %noun] hap)
?~ rob ~
?~ u.rob ~
[~ u.u.rob]
::
++ poke :: external apply
|= {now/@da ovo/ovum}
=. eny (mix eny (shaz now))
:: ~& [%poke -.q.ovo]
^- {(list ovum) _+>}
=^ zef niz
(~(hurl (is vil eny bud niz) now) lac ovo)
[zef +>.$]
|= [now=@da ovo=ovum]
=. eny (shaz (cat 3 eny now))
^- [(list ovum) _+>.$]
::
++ veke :: build new kernel
|= {now/@da hap/path zup/path}
^- *
=- ?:(?=(%& -.res) p.res ((slog p.res) ~))
^= res %- mule |.
=+ pax=(weld hap `path`[%hoon ~])
=+ wax=(weld zup `path`[%hoon ~])
~& [%vega-start-hoon hap]
=+ src=((hard @t) (need (peek now cx+pax)))
=+ arv=((hard @t) (need (peek now cx+wax)))
=+ gen=(rain hap src)
~& %vega-parsed
=+ one=(~(mint ut %noun) %noun gen)
~& %vega-compiled
~& [%vega-arvo zup]
=+ two=(~(mint ut p.one) %noun (rain zup arv))
~& %vega-minted
.*(0 [7 q.one q.two])
:: These external events are actually effects on arvo proper.
:: They can also be produced as the effects of other events.
:: In either case, they fall through here to be handled
:: after the fact in +feck.
::
?: ?=(?(%veer %verb %wack) -.q.ovo)
[[ovo ~] +>.$]
::
=^ zef vanes
(~(hurl (is our vil eny bud vanes) now) lac ovo)
[zef +>.$]
:: +feck: handle an arvo effect
::
++ feck
|= [now=@da ovo=ovum]
^- [(unit ovum) _+>.$]
?+ -.q.ovo
:: pass through unrecognized effect
::
[[~ ovo] +>.$]
:: toggle event verbose event printfs
::
%verb
[~ +>.$(lac !lac)]
:: install %zuse or vane
::
%veer
[~ (veer our now q.ovo)]
:: add data to memory profile
::
%mass
=. q.q.ovo
:- %userspace
:- %|
:~ hoon+`pit
zuse+`bud
:: hoon-cache+`p.niz
q.q.ovo
dot+`.
==
[[~ ovo] +>.$]
:: add entropy
::
%wack
?> ?=(@ q.q.ovo)
=. eny (shaz (cat 3 eny q.q.ovo))
[~ +>.$]
==
::
++ vega :: reboot kernel
|= {now/@da ova/(list ovum) hap/path zup/path}
^- (unit {p/(list ovum) q/*})
|= $: :: now: current date
:: ova: actions to process after reboot
:: hun: hoon.hoon source
:: arv: arvo.hoon source
::
now=@da
ova=(list ovum)
hun=@t
van=@t
==
^- (unit (pair (list ovum) *))
:: virtualize; dump error if we fail
::
=- ?:(?=(%| -.res) ((slog p.res) ~) `p.res)
^= res %- mule |.
=+ ken=(veke now hap zup)
~& [%vega-kernel `@ux`(mug ken)]
=+ ^= nex
=+ gat=.*(ken .*(ken [0 87]))
(need ((hard (unit @)) .*([-.gat [[now ~] +>.gat]] -.gat)))
~& [%vega-compiled hoon-version nex]
?> (lte nex hoon-version)
=+ gat=.*(ken .*(ken [0 ?:(=(nex hoon-version) 86 11)]))
=+ sam=[eny ova q.niz]
=+ raw=.*([-.gat [sam +>.gat]] -.gat)
=+ yep=((list ovum) -.raw)
[[[~ %vega hap] yep] +.raw]
:: produce a new kernel and an effect list
::
++ veer :: install vane/tang
|= {now/@da fav/curd}
^- (pair (list ovum) *)
:: compile the hoon.hoon source with the current compiler
::
=/ raw
~& [%hoon-compile `@p`(mug hun)]
(ride %noun hun)
:: activate the new compiler gate, producing +ride
::
=/ cop .*(0 +.raw)
:: find the hoon version number of the new kernel
::
=/ nex
(@ .*(cop q:(~(mint ut p.raw) %noun [%limb %hoon-version])))
?> |(=(nex hoon-version) =(+(nex) hoon-version))
:: if we're upgrading language versions, recompile the compiler
::
:: hot: raw compiler formula
::
=> ?: =(nex hoon-version)
[hot=`*`raw .]
~& [%hoon-compile-upgrade nex]
=/ hot (slum cop [%noun hun])
.(cop .*(0 +.hot))
:: extract the hoon core from the outer gate (+ride)
::
=/ hoc .*(cop [%0 7])
:: compute the type of the hoon.hoon core
::
=/ hyp -:(slum cop [-.hot '+>'])
:: compile arvo
::
=/ rav
~& [%arvo-compile `@p`(mug hyp) `@p`(mug van)]
(slum cop [hyp van])
:: activate arvo, and extract the arvo core from the outer gate
::
=/ voc .*(hoc [%7 +.rav %0 7])
:: entry gate: ++load for the normal case, ++come for upgrade
::
=/ gat
=/ arm ?:(=(nex hoon-version) 'load' 'come')
:: compute the type of the arvo.hoon core
::
=/ vip -:(slum cop [-.rav '+>'])
:: compute the formula for the upgrade gate
::
=/ fol +:(slum cop [vip arm])
:: produce the upgrade gate
::
.*(voc fol)
:: upgrade gate sample
::
=/ sam
:* our
now
eny
ova
bud
(turn vanes |=([label=@tas =vane] [label vase.vane]))
==
:: call into the new kernel
::
=/ out (slum gat sam)
:: tack a reset notification onto the product
::
[[[/ %vega ~] ((list ovum) -.out)] +.out]
:: +veer: install %zuse or a vane
::
:: Identity is in the sample so the larval stage
:: can use this as well.
::
++ veer
|= [who=ship now=@da fav=curd]
=> .(fav ((hard {$veer lal/@ta pax/path txt/@t}) fav))
=- ?:(?=(%| -.res) ((slog p.res) +>.$) p.res)
^= res %- mule |.
@ -615,20 +881,21 @@
=+ vax=(slap pit gen)
+>.^$(bud vax)
%_ +>.^$
q.niz
|- ^+ q.niz
?~ q.niz
vanes
|- ^+ vanes
?~ vanes
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
=+ vin=(vint lal.fav vil bud pax.fav txt.fav)
=+ vin=(vint who lal.fav vil bud pax.fav txt.fav)
?~ vin
q.niz
[[lal.fav q.sew:u.vin] q.niz]
?. =(lal.fav p.i.q.niz)
[i.q.niz $(q.niz t.q.niz)]
vanes
[[lal.fav vane:u.vin] vanes]
?. =(lal.fav label.i.vanes)
[i.vanes $(vanes t.vanes)]
~& [%vane `@tas`lal.fav pax.fav `@p`(mug txt.fav)]
:_ t.q.niz
:- p.i.q.niz
q.sew:(ruck:(vent lal.fav vil bud [p.niz q.i.q.niz]) pax.fav txt.fav)
:_ t.vanes
:- label.i.vanes
~| [%failed-vane-activation now lal.fav]
vane:(ruck:(vent who lal.fav vil bud [vase.vane.i.vanes *worm]) pax.fav txt.fav)
==
::
++ wish :: external compute

175
sys/hoon.hoon
View File

@ -575,11 +575,14 @@
?.((a b) ~ [~ u=b])
::
++ hunt :: first of units
|* {ord/$-({* *} ?) one/(unit) two/(unit)}
^- (unit ?(_,.+.one _,.+.two))
?~ one two
?~ two one
?:((ord ,.+.one ,.+.two) one two)
|* [ord=$-(^ ?) a=(unit) b=(unit)]
^- %- unit
$? _?>(?=(^ a) u.a)
_?>(?=(^ b) u.b)
==
?~ a b
?~ b a
?:((ord u.a u.b) a b)
::
++ lift :: lift mold (fmap)
|* a/mold :: flipped
@ -784,10 +787,11 @@
=> .(a ^.(homo a))
|- ^+ a
?~ a ~
=+ s=(skid t.a |:(c=i.a (b c i.a)))
%+ weld
$(a (skim t.a |:(c=i.a (b c i.a))))
$(a p.s)
^+ t.a
[i.a $(a (skim t.a |:(c=i.a !(b c i.a))))]
[i.a $(a q.s)]
::
++ spin :: stateful turn
::
@ -817,10 +821,13 @@
++ swag :: slice
|* {{a/@ b/@} c/(list)}
(scag +<-> (slag +<-< c))
:: +turn: transform each value of list :a using the function :b
::
++ turn :: transform
++ turn
~/ %turn
|* {a/(list) b/gate}
|* [a=(list) b=gate]
=> .(a (homo a))
^- (list _?>(?=(^ a) (b i.a)))
|-
?~ a ~
[i=(b i.a) t=$(a t.a)]
@ -2088,7 +2095,7 @@
==
::
++ fo :: modulo prime
^?
^|
|_ a/@
++ dif
|= {b/@ c/@}
@ -2757,7 +2764,7 @@
++ rylq |= a/dn ^- @rq (grd:rq a) :: finish parsing @rq
::
++ rd :: double precision fp
^?
^|
~% %rd +> ~
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
@ -2836,7 +2843,7 @@
::
++ rs :: single precision fp
~% %rs +> ~
^?
^|
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
@ -2915,7 +2922,7 @@
::
++ rq :: quad precision fp
~% %rq +> ~
^?
^|
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
@ -2994,7 +3001,7 @@
::
++ rh :: half precision fp
~% %rh +> ~
^?
^|
|_ r/$?($n $u $d $z)
:: round to nearest, round up, round down, round to zero
::
@ -5374,6 +5381,11 @@
|=(a/tape (rap 3 ^-((list @) a)))
;~(plug low (star ;~(pose nud low hep)))
::
++ mixed-case-symbol
%+ cook
|=(a/tape (rap 3 ^-((list @) a)))
;~(plug alf (star alp))
::
++ ven ;~ (comp |=({a/@ b/@} (peg a b))) :: +>- axis syntax
bet
=+ hom=`?`|
@ -5771,27 +5783,7 @@
++ crub
~+
;~ pose
%+ cook
|=(det/date `dime`[%da (year det)])
;~ plug
%+ cook
|=({a/@ b/?} [b a])
;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
;~(pfix dot mot:ag) :: month
;~(pfix dot dip:ag) :: day
;~ pose
;~ pfix
;~(plug dot dot)
;~ plug
dum:ag
;~(pfix dot dum:ag)
;~(pfix dot dum:ag)
;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
==
==
(easy [0 0 0 ~])
==
==
(cook |=(det/date `dime`[%da (year det)]) when)
::
%+ cook
|= {a/(list {p/?($d $h $m $s) q/@}) b/(list @)}
@ -5915,6 +5907,28 @@
(stag %$ crub)
==
::
++ when
~+
;~ plug
%+ cook
|=({a/@ b/?} [b a])
;~(plug dim:ag ;~(pose (cold | hep) (easy &)))
;~(pfix dot mot:ag) :: month
;~(pfix dot dip:ag) :: day
;~ pose
;~ pfix
;~(plug dot dot)
;~ plug
dum:ag
;~(pfix dot dum:ag)
;~(pfix dot dum:ag)
;~(pose ;~(pfix ;~(plug dot dot) (most dot qix:ab)) (easy ~))
==
==
(easy [0 0 0 ~])
==
==
::
++ zust
~+
;~ pose
@ -5928,16 +5942,45 @@
::
:::: 4m: formatting functions
::
++ scot |=(mol/dime ~(rent co %$ mol))
++ scow |=(mol/dime ~(rend co %$ mol))
++ scot
~/ %scot
|=(mol/dime ~(rent co %$ mol))
++ scow
~/ %scow
|=(mol/dime ~(rend co %$ mol))
++ slat |=(mod/@tas |=(txt/@ta (slaw mod txt)))
++ slav |=({mod/@tas txt/@ta} (need (slaw mod txt)))
++ slaw
~/ %slaw
|= {mod/@tas txt/@ta}
^- (unit @)
?+ mod
:: slow fallback case to the full slay
::
=+ con=(slay txt)
?.(&(?=({~ $$ @ @} con) =(p.p.u.con mod)) ~ [~ q.p.u.con])
::
%da
(rush txt ;~(pfix sig (cook year when:so)))
::
%p
(rush txt ;~(pfix sig fed:ag))
::
%ud
(rush txt dem:ag)
::
%ux
(rush txt ;~(pfix (jest '0x') hex:ag))
::
%uv
(rush txt ;~(pfix (jest '0v') viz:ag))
::
%ta
(rush txt ;~(pfix ;~(plug sig dot) urs:ab))
::
%tas
(rush txt sym)
==
::
++ slay
|= txt/@ta ^- (unit coin)
@ -6131,7 +6174,7 @@
^- toon
?. &(?=(^ gat) ?=(^ +.gat))
[%2 ~]
(mock [[-.gat [sam +>.gat]] -.gat] gul)
(mock [gat(+< sam) %9 2 %0 1] gul)
::
++ mule :: typed virtual
~/ %mule
@ -6147,12 +6190,19 @@
++ mute :: untyped virtual
|= taq/_=>(~ ^?(|.(**)))
^- (each * (list tank))
=+ ton=(mock [taq 9 2 0 1] |=({* *} ~))
=+ ton=(mock [taq %9 2 %0 1] |=({* *} ~))
?- -.ton
$0 [%& p.ton]
$1 [%| (turn p.ton |=(a/* (smyt (path a))))]
$2 [%| p.ton]
==
:: +slum: slam a gate on a sample using raw nock, untyped
::
++ slum
~/ %slum
|= [gat=* sam=*]
^- *
.*(gat [%9 2 %10 [6 %1 sam] %0 1])
::
++ soft :: maybe remold
|* han/$-(* *)
@ -9730,10 +9780,11 @@
^- type
?- -.lap
%& p.lap
%| %- fire
%| %- fork
%+ turn ~(tap in q.lap)
|= {a/type b/foot}
[a [%dry %$ 1]]
|= [a=type *]
?> ?=([%core *] a)
[%core q.q.a q.a]
==
:: ::
++ feel :: detect existence
@ -9851,7 +9902,7 @@
%wet [%wet q.u.zem]
%dry [%dry q.u.zem]
==
[%| (peg 2 p.u.zem) [[sut(r.p.q %gold) zut] ~ ~]]
[%| (peg 2 p.u.zem) [[sut zut] ~ ~]]
=+ pec=(peel way r.p.q.sut)
?. sam.pec lose
?: con.pec $(sut p.sut, axe (peg axe 3))
@ -9959,7 +10010,7 @@
?. ?=({$core *} p)
~_ (dunk %fire-type)
~>(%mean.[%leaf "fire-core"] !!)
=+ dox=[%core q.q.p q.p]
=+ dox=[%core q.q.p q.p(r.p %gold)]
?: ?=($dry -.q)
:: ~_ (dunk(sut [%cell q.q.p p.p]) %fire-dry)
?> ?|(!vet (nest(sut q.q.p) & p.p))
@ -10725,10 +10776,19 @@
{$core *}
?. =(3 now) %noun
=+ pec=(peel way r.p.q.sut)
=/ tow
?: =(1 lat) 1
(cap lat)
%= ^$
axe lat
sut
?: =([& &] pec) p.sut
?: ?| =([& &] pec)
&(sam.pec =(tow 2))
&(con.pec =(tow 3))
==
p.sut
~_ leaf+"payload-block"
?. =(way %read) !!
%+ cell
?.(sam.pec %noun ^$(sut p.sut, axe 2))
?.(con.pec %noun ^$(sut p.sut, axe 3))
@ -11275,7 +11335,7 @@
$type
=+ tyr=|.((dial dole))
=+ vol=tyr(sut lum)
=+ cis=((hard tank) .*(vol -:vol))
=+ cis=((hard tank) .*(vol [%9 2 %0 1]))
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
@ -11573,6 +11633,7 @@
++ seem |=(toy/typo `type`toy) :: promote typo
++ seer |=(vix/vise `vase`vix) :: promote vise
++ sell :: tank pretty-print
~/ %sell
|= vax/vase ^- tank
~| %sell
(~(deal us p.vax) q.vax)
@ -12076,7 +12137,14 @@
%+ cook
|= {a/@tas b/(unit @tas)}
?~(b a [a u.b])
;~(plug sym ;~(pose (stag ~ ;~(pfix cab sym)) (easy ~)))
;~ plug
mixed-case-symbol
;~ pose
%+ stag ~
;~(pfix cab mixed-case-symbol)
(easy ~)
==
==
::
++ en-class
|= a/(list {$class p/term})
@ -13889,7 +13957,7 @@
++ wa !: :: cached compile
|_ worm
++ nell |=(ref/type (nest [%cell %noun %noun] ref)) :: nest in cell
++ nest :: nest:ut
++ nest :: nest:ut, cached
|= {sut/type ref/type}
^- {? worm}
?: (~(has in nes) [sut ref]) [& +>+<]
@ -13940,11 +14008,11 @@
^- {? worm}
?: (~(has in nes) [sut ref]) [& +>+<]
=+ gat=|=({a/type b/type} (~(nest ut a) | b))
?. (? .*(gat(+< [sut ref]) -.gat))
?. (? (slum gat [sut ref]))
~& %nets-failed
=+ tag=`*`skol
=+ foo=(tank .*(tag(+< ref) -.tag))
=+ bar=(tank .*(tag(+< sut) -.tag))
=+ foo=(tank (slum tag ref))
=+ bar=(tank (slum tag sut))
~& %nets-need
~> %slog.[0 bar]
~& %nets-have
@ -13980,6 +14048,11 @@
=^ gun +>+< (mint p.vax [%$ axe])
[[p.gun .*(q.vax [0 axe])] +>+<.$]
::
++ slym :: ++slym, cached
|= {gat/vase sam/*}
^- [vase worm]
(slap gat(+<.q sam) [%limb %$])
::
++ sped :: specialize vase
|= vax/vase
^- {vase worm}

371
sys/vane/ames.hoon
View File

@ -68,7 +68,7 @@
++ go :: go
|_ ton=town :: ames state
++ as :: as:go
|_ [our=ship saf=sufi] :: per server
|_ our=ship :: per server
++ lax :: lax:as:go
|_ [her=ship dur=dore] :: per client
++ cluy :: cluy:lax:as:go
@ -222,7 +222,7 @@
&(!?=(%czar rac) =(our seg))
==
~
`law.saf
`law.ton
=/ yig sen
=/ hom (jam ham)
?: =(~ lew.wod.dur)
@ -257,37 +257,35 @@
|= her=ship
^+ lax
=/ fod=dore
(fall (~(get by hoc.saf) her) (gur her))
(fall (~(get by hoc.ton) her) (gur her))
~(. lax [her fod])
::
++ nux :: install dore
|= new=_lax
^+ +>
+>(hoc.saf (~(put by hoc.saf) her.new dur.new))
+>(hoc.ton (~(put by hoc.ton) her.new dur.new))
::
++ sen :: current crypto
^- [lyf=life cub=acru]
?~(val.saf !! [p.i.val.saf r.i.val.saf])
?~(val.ton !! [p.i.val.ton r.i.val.ton])
::
++ sev :: crypto by life
|= mar=life
^- [p=? q=acru]
?~ val.saf !!
?: =(mar p.i.val.saf)
[& r.i.val.saf]
?> (lth mar p.i.val.saf)
?~ val.ton !!
?: =(mar p.i.val.ton)
[& r.i.val.ton]
?> (lth mar p.i.val.ton)
:- |
|- ^- acru
?> ?=(^ t.val.saf)
?: =(mar p.i.t.val.saf)
r.i.t.val.saf
$(t.val.saf t.t.val.saf)
?> ?=(^ t.val.ton)
?: =(mar p.i.t.val.ton)
r.i.t.val.ton
$(t.val.ton t.t.val.ton)
-- :: --as:go
::
++ su :: install safe
|= new=_as
^- town
ton(urb (~(put by urb.ton) our.new saf.new))
|=(new=_as `town`ton.new)
::
++ ti :: expire by time
|= now=@da
@ -295,11 +293,7 @@
!!
::
++ us :: produce safe
|= our=ship
^- (unit _as)
=+ goh=(~(get by urb.ton) our)
?~ goh ~
[~ ~(. as [our u.goh])]
|=(our=ship `_as`~(. as our))
-- :: --go
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::
@ -514,59 +508,67 @@
::
|%
++ am :: am
|_ [now=@da fox=fort ski=sley] :: protocol engine
~% %ames-am ..is ~
|_ [our=ship now=@da fox=fort ski=sley] :: protocol engine
:: +deed: scry for our deed
::
++ deed
|= [our=ship now=@da lyf=life]
~/ %deed
|= [who=ship lyf=life]
;; ^deed
%- need %- need
%- (sloy ski)
%- (sloy-light ski)
=/ pur=spur
/(scot %ud lyf)/(scot %p our)
[[151 %noun] %j (en-beam:format [our %deed da+now] pur)]
/(scot %ud lyf)/(scot %p who)
[[151 %noun] %j our %deed da+now pur]
:: +sein: scry for sponsor
::
++ sein
|= [our=ship now=@da who=ship]
~/ %sein
|= who=ship
;; ship
%- need %- need
%- (sloy ski)
[[151 %noun] %j (en-beam:format [our %sein da+now] /(scot %p who))]
%- (sloy-light ski)
[[151 %noun] %j our %sein da+now /(scot %p who)]
:: +saxo: scry for sponsorship chain
::
++ saxo
|= [our=ship now=@da who=ship]
~/ %saxo
|= who=ship
;; (list ship)
%- need %- need
%- (sloy ski)
[[151 %noun] %j (en-beam:format [our %saxo da+now] /(scot %p who))]
%- (sloy-light ski)
[[151 %noun] %j our %saxo da+now /(scot %p who)]
::
++ vein :: vein:am
|= [our=ship =life vein=(map life ring)] :: new private keys
~/ %vein
|= [=life vein=(map life ring)] :: new private keys
^- fort
::
?. ?& (~(has by vein) life)
=(life (roll ~(tap in ~(key by vein)) max))
==
~| [%vein-mismatch +<] !!
:: XX single-home
%= fox
hoc.ton
:: reset connections
::
?. ?| (~(has by urb.ton.fox) our)
=(~ urb.ton.fox)
==
~| [%strange-vein +<] !!
=/ suf=sufi (fall (~(get by urb.ton.fox) our) *sufi)
:: reset symmetric keys
(~(run by hoc.ton.fox) |=(=dore dore(caq *clot)))
::
=. hoc.suf (~(run by hoc.suf) |=(=dore dore(caq *clot)))
=. seh.suf ~
seh.ton
:: reset symmetric key cache
::
~
::
:: save our secrets, ready for action
law.ton
:: save our deed (for comet/moon communication)
::
=. law.suf (deed our now life)
(deed our life)
::
val.ton
:: save our secrets, ready for action
::
=. val.suf
^- wund
%+ turn
%+ sort
@ -575,80 +577,81 @@
(gth life.a life.b)
|= [=^life =ring]
[life ring (nol:nu:crub:crypto ring)]
=/ con=corn (fall (~(get by zac.fox) our) *corn)
%= fox
urb.ton (~(put by urb.ton.fox) our suf)
zac (~(put by zac.fox) our con)
==
::
++ gnaw :: gnaw:am
~/ %gnaw
|= [kay=cape ryn=lane pac=rock] :: process packet
^- [p=(list boon) q=fort]
?. =(protocol-version (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)
?: (goop p.p.kec)
[~ fox]
?. =(our q.p.kec)
[~ fox]
=; zap=[p=(list boon) q=fort]
[(weld p.zap next) q.zap]
=< zork
=< zank
:: ~& [%hear p.p.kec ryn `@p`(mug (shaf %flap pac))]
%- ~(chew la:(ho:(um q.p.kec) p.p.kec) kay ryn %none (shaf %flap pac))
%- ~(chew la:(ho:um p.p.kec) kay ryn %none (shaf %flap pac))
[q.kec r.kec]
::
++ goop :: blacklist
|= him=ship
|
::
++ hall :: hall:am
^- (list sock) :: all sockets
=| sox=(list sock) :: XX hideous
|- ^+ sox
?~ zac.fox sox
=. sox $(zac.fox l.zac.fox)
=. sox $(zac.fox r.zac.fox)
|- ^+ sox
?~ wab.q.n.zac.fox sox
=. sox $(wab.q.n.zac.fox l.wab.q.n.zac.fox)
=. sox $(wab.q.n.zac.fox r.wab.q.n.zac.fox)
[[p.n.zac.fox p.n.wab.q.n.zac.fox] sox]
::
++ kick :: kick:am
|= hen=duct :: refresh net
=+ aks=(turn ~(tap by urb.ton.fox) |=([p=ship q=sufi] p))
|- ^- [p=(list boon) q=fort]
?~ aks [~ fox]
=^ buz fox zork:(kick:(um i.aks) hen)
=^ biz fox $(aks t.aks)
[(weld p.buz p.biz) fox]
^- [p=(list boon) q=fort]
zork:(kick:um hen)
::
++ next
^- (list boon)
=/ doz=(unit @da) [~ (add now ~s32)]
=. doz
|- ^+ doz
?~ wab.zac.fox doz
=. doz $(wab.zac.fox l.wab.zac.fox)
=. doz $(wab.zac.fox r.wab.zac.fox)
=+ bah=q.n.wab.zac.fox
(hunt lth doz rtn.sop.bah)
=/ nex (hunt lth doz tim.fox)
?: =(tim.fox nex)
~
[%pito (need nex)]~
::
++ rack :: rack:am
|= [soq=sock cha=path cop=coop] :: e2e ack
=+ oh=(ho:(um p.soq) q.soq)
~/ %rack
|= [her=ship cha=path cop=coop] :: e2e ack
=/ oh (ho:um her)
=^ gud oh (cook:oh cop cha ~)
?. gud oh
(cans:oh cha)
::
++ wake :: wake:am
~/ %wake
|= hen=duct :: harvest packets
^- [p=(list boon) q=fort]
=+ sox=hall
=. tim.fox ~
=/ neb=(list ship) ~(tap in ~(key by wab.zac.fox))
=| bin=(list boon)
|- ^- [p=(list boon) q=fort]
?~ sox
?~ neb
=^ ban fox (kick hen)
[(weld bin p.ban) fox]
=^ bun fox zork:zank:thaw:(ho:(um p.i.sox) q.i.sox)
$(sox t.sox, bin (weld p.bun bin))
[:(weld bin p.ban next) fox]
=^ bun fox zork:zank:thaw:(ho:um i.neb)
$(neb t.neb, bin (weld p.bun bin))
::
++ wise :: wise:am
|= [soq=sock hen=duct cha=path val=*] :: send a statement
|= [hen=duct her=ship cha=path val=*] :: send a statement
^- [p=(list boon) q=fort]
zork:zank:(wool:(ho:(um p.soq) q.soq) hen cha val)
=^ ban fox zork:zank:(wool:(ho:um her) hen cha val)
[(weld p.ban next) fox]
::
++ um :: per server
|= our=ship
=/ gus (need (~(us go ton.fox) our))
=/ weg=corn (fall (~(get by zac.fox) our) *corn)
=/ gus (~(us go ton.fox) our)
=/ weg=corn zac.fox
=| bin=(list boon)
|%
++ ho :: ho:um:am
@ -713,7 +716,7 @@
bin
:_ bin
:^ %milk
[our her]
her
`soap`[[lyf:sen:gus clon:diz] cha did.rum]
u.s.u.cun
==
@ -736,7 +739,7 @@
?^ ram raz.bah
%+ ~(put by raz.bah) cha
rum(dod &, bum ?~(cop bum.rum (~(put by bum.rum) did.rum u.cop)))
=/ seg (sein our now her)
=/ seg (sein her)
=^ roc diz (zuul:diz now seg [%back cop dam ~s0])
(busk(diz (wast:diz ryn)) xong roc)
:: XX move this logic into %zuse, namespaced under %jael?
@ -782,7 +785,7 @@
:: our sponsor
::
?& !?=(%czar (clan:title our))
=(her (sein our now our))
=(her (sein our))
==
==
diz(lew.wod.dur law)
@ -812,10 +815,10 @@
^+ +>.$
:: bos: our sponsor
::
=/ bos (sein our now our)
=/ bos (sein our)
:: seg: her sponsor
::
=/ seg (sein our now her)
=/ seg (sein her)
:: rac: her rank
::
=/ rac (clan:title her)
@ -825,7 +828,7 @@
:: XX update state so we only ask once?
::
=? +>.$ &(=(~ lew.wod.dur.diz) =(her bos))
(emit %beer our her)
(emit %beer her)
:: request keys and drop packet if :her is (or is a moon of)
:: an unfamilar on-chain ship (and not our sponsor)
::
@ -833,26 +836,26 @@
!=(her bos)
?| !?=(?(%earl %pawn) rac)
?& ?=(%earl rac)
=/ fod (~(get by hoc.saf.gus) seg)
=/ fod (~(get by hoc.ton.fox) seg)
?| ?=(~ fod)
?=(~ lew.wod.u.fod)
== == == ==
(emit %beer our ?:(?=(%earl rac) seg her))
(emit %beer ?:(?=(%earl rac) seg her))
=/ oub bust:puz
=/ neg =(~ yed.caq.dur.diz)
=. +>.$ east
=/ eng =(~ yed.caq.dur.diz)
=/ bou bust:puz
=? +>.$ &(oub !bou)
(emit [%wine [our her] " is ok"])
(emit [%wine her " is ok"])
:: the presence of a symmetric key indicates neighboring
:: XX use deed instead?
::
=? +>.$ &(neg !eng)
%- emir :~
[%wine [our her] " is your neighbor"]
[%wine her " is your neighbor"]
?> ?=(^ lew.wod.dur.diz)
[%raki [our her] [life pass]:u.lew.wod.dur.diz]
[%raki her [life pass]:u.lew.wod.dur.diz]
==
+>.$
::
@ -918,7 +921,7 @@
^+ . :: send new ack
:: ~& [%back kay dam]
=* cop `coop`?:(=(%good kay) ~ ``[%dead-packet ~])
=/ seg (sein our now her)
=/ seg (sein her)
=^ pax diz (zuul:diz now seg [%back cop dam ~s0])
+>(+> (busk(diz (wast:diz ryn)) xong pax))
::
@ -1047,7 +1050,7 @@
=+ bou=bust:puz
=. bin
?. &(bou !oub) bin
:_(bin [%wine [our her] " not responding still trying"])
:_(bin [%wine her " not responding still trying"])
=. diz ?:((boom:puz now) (pode:diz now) diz)
(busk xong yem)
::
@ -1063,7 +1066,7 @@
%= +>.$
bin
:_ bin
`boon`[%cake [our her] [[lyf:sen:gus clon:diz] u.p.yoh] cop u.hud]
`boon`[%cake her [[lyf:sen:gus clon:diz] u.p.yoh] cop u.hud]
==
(busk xong q.yoh)
::
@ -1071,7 +1074,7 @@
|= [gom=soup ham=meal]
:: ~& [%wind her gom]
^+ +>
=/ seg (sein our now her)
=/ seg (sein her)
=^ wyv diz (zuul:diz now seg ham)
=^ feh puz (whap:puz now gom wyv)
(busk xong feh)
@ -1087,7 +1090,7 @@
::
:: XX update state so we only ask once?
::
=? bin =(~ lew.wod.dur.diz) :_(bin [%beer our her])
=? bin =(~ lew.wod.dur.diz) :_(bin [%beer her])
=. ryl.bah
%+ ~(put by ryl.bah) cha
%= rol
@ -1147,8 +1150,8 @@
::
++ xong :: xong:ho:um:am
^- (list ship) :: route unto
=/ fro (saxo our now our)
=/ too (saxo our now her)
=/ fro (saxo our)
=/ too (saxo her)
=+ ^= oot ^- (list ship)
=| oot=(list ship)
|- ^+ oot
@ -1162,7 +1165,7 @@
++ kick :: kick:um:am
|= hen=duct :: test connection
^+ +>
=/ hoy (tail (saxo our now our))
=/ hoy (tail (saxo our))
|- ^+ +>.^$
?~ hoy
+>.^$
@ -1186,7 +1189,7 @@
:- (flop bin)
%_ fox
ton (~(su go ton.fox) gus)
zac (~(put by zac.fox) our.gus weg)
zac weg
==
-- :: --um:am
-- :: --am
@ -1197,43 +1200,25 @@
::
=| $: fox=fort :: kernel state
== ::
|= [now=@da eny=@ ski=sley] :: current invocation
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
^? :: opaque core
=<
~% %ames-protocol ..is ~
|% :: vane interface
++ call :: handle request
~/ %call
|= $: hen=duct
hic=(hypo (hobo task:able))
type=*
wrapped-task=(hobo task:able)
==
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=(%soft -.q.hic)
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%ames-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
^- [p=(list move) q=_..^$]
=^ duy ..knob
(knob hen q.hic)
^- [(list move) _..^$]
=/ task=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
((hard task:able) p.wrapped-task)
=^ duy ..knob (knob hen task)
[duy ..^$]
::
++ doze
|= [now=@da hen=duct]
=+ doz=`(unit @da)`[~ (add now ~s32)]
|- ^+ doz
?~ zac.fox doz
=. doz $(zac.fox l.zac.fox)
=. doz $(zac.fox r.zac.fox)
=+ yem=q.n.zac.fox
|- ^+ doz
?~ wab.yem doz
=. doz $(wab.yem l.wab.yem)
=. doz $(wab.yem r.wab.yem)
=+ bah=q.n.wab.yem
(hunt lth doz rtn.sop.bah)
::
++ load
|= old=fort
..^$(fox old)
@ -1249,25 +1234,27 @@
?. ?=([$$ %da @] lot)
~
?. =(now q.p.lot) ~
(temp p.why u.hun [syd t.tyl])
(temp u.hun [syd t.tyl])
::
++ stay fox
++ take :: accept response
~/ %take
|= [tea=wire hen=duct hin=(hypo sign:able)]
^- [p=(list move) q=_..^$]
^- [(list move) _..^$]
=^ duy ..knap
(knap tea hen q.hin)
[duy ..^$]
--
~% %ames-impl ..is ~
|%
++ clop
~/ %clop
|= [now=@da hen=duct bon=boon]
^- [(list move) fort]
?- -.bon
%beer
=/ wir=wire
/our/(scot %p p.p.bon)/her/(scot %p q.p.bon)
:_ fox [hen [%pass wir %j %pubs p.p.bon q.p.bon]]~
=/ =wire /pubs/(scot %p p.bon)
:_ fox [hen [%pass wire %j %pubs p.bon]]~
::
%bock
:_ fox [hen %give %turf tuf.fox]~
@ -1278,32 +1265,42 @@
%cake
:: ~? ?=(^ r.bon) [%cake-woot-bad hen r.bon]
:_ fox
:~ [s.bon %give %woot q.p.bon r.bon]
:~ [s.bon %give %woot p.bon r.bon]
==
::
%mead :_(fox [[hen [%give %hear p.bon q.bon]] ~])
%mead
=^ moz +>.$ (knob hen [%hear p.bon q.bon])
[moz fox]
::
%milk
:: ~& [%milk p.bon q.bon]
?> ?=([@ @ *] q.q.bon)
?> ?=(?(%a %c %e %g %j) i.q.q.bon)
=+ pax=[(scot %p p.p.bon) (scot %p q.p.bon) q.q.bon]
:_ fox [hen %pass pax i.q.q.bon %west p.bon t.q.q.bon r.bon]~
=/ =wire [(scot %p our) (scot %p p.bon) q.q.bon]
:_ fox [hen %pass wire i.q.q.bon %west p.bon t.q.q.bon r.bon]~
::
%ouzo
:: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))]
~| [%ames-bad-duct duct=gad.fox lane=p.bon]
?> ?=(^ gad.fox)
:_ fox
[[gad.fox [%give %send p.bon q.bon]] ~]
::
%pito
:_ fox(tim `p.bon)
:- [gad.fox %pass /ames %b %wait p.bon]
?~ tim.fox ~
[gad.fox %pass /ames %b %rest u.tim.fox]~
::
%raki
=* our p.p.bon
=* her q.p.bon
=* her p.bon
=/ moz=(list move)
[hen [%pass / %j %meet our her life=q.bon pass=r.bon]]~
[hen [%pass / %j %meet her life=q.bon pass=r.bon]]~
:: poke :dns with an indirect binding if her is a planet we're spnsoring
::
=? moz ?& ?=(%duke (clan:title her))
?=(%king (clan:title our))
=(our (~(sein am [now fox ski]) our now her))
=(our (~(sein am [our now fox ski]) her))
==
=/ cmd [%meet her]
=/ pok [%dns %poke `cage`[%dns-command !>(cmd)]]
@ -1311,13 +1308,12 @@
[moz fox]
::
%sake
=/ wir=wire
/our/(scot %p p.bon)
:_ fox [hen [%pass wir %j %vein p.bon]]~
=/ =wire /our/(scot %p our)
:_ fox [hen [%pass wire %j %vein ~]]~
::
%wine
:_ fox
=+ fom=~(rend co %$ %p q.p.bon)
=+ fom=~(rend co %$ %p p.bon)
:~ :- hen
:+ %slip %d
:+ %flog %text
@ -1330,6 +1326,7 @@
==
::
++ knap
~/ %knap
|= [tea=wire hen=duct sih=sign:able]
^- [(list move) _+>]
?- +<.sih
@ -1343,12 +1340,11 @@
[~ +>.$]
::
%pubs
?. ?=([%our @ %her @ ~] tea)
?. ?=([%pubs @ ~] tea)
~& [%strange-pubs tea]
[~ +>]
=/ our=ship (slav %p i.t.tea)
=/ her=ship (slav %p i.t.t.t.tea)
=/ gus (need (~(us go ton.fox) our))
=/ her=ship (slav %p i.t.tea)
=/ gus (~(us go ton.fox) our)
=/ diz (myx:gus her)
?: =(0 life.sih)
:: this should clear lew.wod.dur.diz because it means
@ -1370,22 +1366,30 @@
?. ?=([%our @ ~] tea)
~& [%strange-vein tea]
[~ +>]
=/ our=ship (slav %p i.t.tea)
=. fox (~(vein am [now fox ski]) our life.sih vein.sih)
=. fox (~(vein am [our now fox ski]) life.sih vein.sih)
[~ +>.$]
::
%woot [~ +>]
::
*
=+ ^= fuy
^- [p=(list boon) q=fort]
?- +<.sih
::
%wake
(~(wake am [our now fox ski]) hen)
::
?(%mean %nice) :: XX obsolete
?: ?=([%ye ~] tea)
[~ +>.$]
[~ fox]
?> ?=([@ @ @ *] tea)
=+ soq=[(slav %p i.tea) (slav %p i.t.tea)]
=+ pax=t.t.tea
=+ ^= fuy
=/ her (slav %p i.t.tea)
=* pax t.t.tea
=< zork =< zank
%^ ~(rack am [now fox ski]) soq pax
%^ ~(rack am [our now fox ski]) her pax
:: ~& [%knap-ack ?-(+<.sih %mean `p.+.sih, %nice ~)]
?-(+<.sih %mean `p.+.sih, %nice ~)
==
=> %_(. fox q.fuy)
=| out=(list move)
|- ^- [p=(list move) q=_+>.^$]
@ -1396,6 +1400,7 @@
==
::
++ knob
~/ %knob
|= [hen=duct kyz=task:able]
^- [(list move) _+>]
?: ?=(%crud -.kyz)
@ -1415,16 +1420,16 @@
[%bock ~]~
::
%hear
(~(gnaw am [now fox ski]) %good p.kyz q.kyz)
(~(gnaw am [our now fox ski]) %good p.kyz q.kyz)
::
%halo
(~(gnaw am [now fox ski]) %dead p.kyz q.kyz)
(~(gnaw am [our now fox ski]) %dead p.kyz q.kyz)
::
%hole
(~(gnaw am [now fox ski]) %dead p.kyz q.kyz)
(~(gnaw am [our now fox ski]) %dead p.kyz q.kyz)
::
%init
:_ fox [[%sake p.kyz] [%brew ~] ~]
:_ fox [[%sake ~] [%brew ~] ~]
::
:: XX this is unused, but they only way to set
:: entropy for symmetric keys. Review.
@ -1433,7 +1438,10 @@
[~ fox(any.ton (shax (mix any.ton.fox p.kyz)))]
::
%kick
(~(kick am [now fox(hop p.kyz) ski]) hen)
=^ ban fox (~(kick am [our now fox(hop p.kyz) ski]) hen)
:: +next:am called here because +wake calls +kick in a loop
::
[(weld p.ban ~(next am [our now fox ski])) fox]
::
%nuke
:- ~
@ -1444,18 +1452,10 @@
fox(bad (~(put in bad.fox) p.kyz))
::
%sunk
:: XX single-home properly
::
=/ our=ship
=/ key ~(key by urb.ton.fox)
?>(?=([@ ~ ~] key) n.key)
=* who p.kyz
=* lyf q.kyz
=/ saf=sufi (~(got by urb.ton.fox) our)
=/ con=corn (~(got by zac.fox) our)
::
?: =(our who)
?: (lth lyf p:(head val.saf))
?: (lth lyf p:(head val.ton.fox))
:: replaying our old sinkage, ignore
:: XX review
::
@ -1463,22 +1463,18 @@
:: XX include some helpful instructions here
::
:_ fox
[%wine [our who] ", you have sunk"]~
[%wine who ", you have sunk"]~
::
=. saf saf(hoc (~(del by hoc.saf) who))
=. con con(wab (~(del by wab.con) who))
::
:- [%wine [our who] " has sunk"]~
%= fox
urb.ton (~(put by urb.ton.fox) our saf)
zac (~(put by zac.fox) our con)
=: hoc.ton.fox (~(del by hoc.ton.fox) who)
wab.zac.fox (~(del by wab.zac.fox) who)
==
[[%wine who " has sunk"]~ fox]
::
%wake
(~(wake am [now fox ski]) hen)
(~(wake am [our now fox ski]) hen)
::
%want
(~(wise am [now fox ski]) p.kyz hen q.kyz r.kyz)
(~(wise am [our now fox ski]) hen p.kyz q.kyz r.kyz)
==
=> %_(. fox q.fuy)
=| out=(list move)
@ -1489,18 +1485,17 @@
$(p.fuy t.p.fuy, out (weld (flop toe) out))
::
++ temp
|= [our=ship his=ship tyl=path]
~/ %temp
|= [his=ship tyl=path]
^- (unit (unit cage))
?: ?=([?(%show %tell) *] tyl)
?^ t.tyl [~ ~]
=+ gys=(~(us go ton.fox) our)
?~ gys [~ ~]
=+ zet=zest:(ho:(~(um am [now fox ski]) our) his)
=+ zet=zest:(ho:~(um am [our now fox ski]) his)
``[%noun ?:(=(%show i.tyl) !>(>zet<) !>(zet))]
?: ?=([%pals ~] tyl)
?. =(our his)
~
``[%noun !>(pals:(~(um am [now fox ski]) our))]
``[%noun !>(pals:~(um am [our now fox ski]))]
~
::
++ wegh

357
sys/vane/behn.hoon
View File

@ -1,230 +1,187 @@
:: :: %behn, just a timer
:: %behn, just a timer
::
!? 164
::::
::
=, behn
|= pit/vase
=> =~
|%
+* sqeu [a b] :: binary skew queno
$~ [0 *a *b ~] ::
$: r/@u :: rank+depth
k/a :: priority
n/b :: value
c/(broq a b) :: children
== ::
+* broq [a b] :: brodal skew qeu
(list (sqeu a b)) ::
+$ move {p/duct q/(wind note gift:able)} :: local move
+$ note ~ :: out request $->
+$ sign ~ :: in result $<-
+$ clok (broq @da duct) :: stored timers
+$ coke $~ [%0 ~ ~]
$: $0 :: all state
tym/{p/clok q/clok} :: positive+negative
== ::
--
::
|%
++ raze
|= tym/{p/clok q/clok}
^+ tym
?~ p.tym tym
?~ q.tym tym
?: (gth p:~(get up p.tym) p:~(get up q.tym)) :: killed nonexisting
~& [%snooze-lost del=p:~(get up q.tym) top=p:~(get up p.tym)]
$(q.tym ~(pop up q.tym))
?: =(~(get up p.tym) ~(get up q.tym))
$(tym [~(pop up p.tym) ~(pop up q.tym)])
tym
::
++ up :: priority queue
=+ [key=@da val=duct]
=+ cmp=lte :: lte=min, gte=max
|= pit=vase
=> |%
++ link
|= {p/(sqeu key val) q/(sqeu key val)} :: link eq rank
^- (sqeu key val)
?> =(r.p r.q)
?: (cmp k.p k.q)
[r=+(r.p) k=k.p n=n.p c=[i=q t=c.p]]
[r=+(r.q) k=k.q n=n.q c=[i=p t=c.q]]
+$ move [p=duct q=(wind note:able gift:able)]
+$ sign ~
::
++ sink :: skew link
|= {p/(sqeu key val) q/(sqeu key val) r/(sqeu key val)}
^- (sqeu key val)
?: &((cmp k.q k.p) (cmp k.q k.r))
[r=+(r.q) k=k.q n=n.q c=[i=p t=[i=r t=c.q]]]
?: &((cmp k.r k.p) (cmp k.r k.q))
[r=+(r.r) k=k.r n=n.r c=[i=p t=[i=q t=c.r]]]
[r=+(r.q) k=k.p n=n.p c=[i=q t=[i=r t=~]]]
+$ behn-state
$: timers=(list timer)
unix-duct=duct
next-wake=(unit @da)
==
::
++ sert :: internal ins op
|= {p/(sqeu key val) q/(broq key val)}
^- (broq key val)
?~ q [p ~]
?> (lte r.p r.i.q)
?: (lth r.p r.i.q)
[i=p t=q]
$(p (link p i.q), q t.q)
::
++ uniq :: remove init dup
|= q/(broq key val)
?~ q ~
(sert i.q t.q)
::
++ meek :: unique meld
|= {p/(broq key val) q/(broq key val)}
^- (broq key val)
?~ p q
?~ q p
?: (lth r.i.p r.i.q)
[i.p $(p t.p)]
?: (lth r.i.q r.i.p)
[i.q $(q t.q)]
(sert (link i.p i.q) $(p t.p, q t.q))
::
++ mini :: getmin
|= q/(broq key val)
^- p/{(sqeu key val) (broq key val)}
?~ q ~|(%fatal-mini-empty !!)
?~ t.q [i=i.q t=~]
=+ [l r]=$(q t.q)
?: (cmp k.i.q k.l)
[i.q t.q]
[l [i.q r]]
::
++ spit :: split
|= {p/(broq key val) q/(list {k/key n/val}) r/(broq key val)}
^- {t/(broq key val) x/(list {k/key n/val})}
?~ r
[t=p x=q]
?: =(0 r.i.r)
$(q [[k=k.i.r n=n.i.r] q], r t.r)
$(p [i.r p], r t.r)
+$ timer [date=@da =duct]
--
|_ a/(broq key val) :: public interface
++ put :: insert element
|= {k/key n/val}
^+ a
?~ a [i=[r=0 k=k n=n c=~] t=~]
?~ t.a [i=[r=0 k=k n=n c=~] t=a]
?: =(r.i.a r.i.t.a)
[i=(sink [r=0 k=k n=n c=~] i.a i.t.a) t=t.t.a]
[i=[r=0 k=k n=n c=~] t=a]
::
++ pop :: remove top
^+ a
=+ ?~ a ~|(%empty-broq-pop !!)
[l r]=(mini a)
=+ [t x]=(spit ~ ~ c.l)
=. a r
=. a (uni t)
(gas x)
::
++ gas
|= b/(list {k/key n/val})
^+ a
(roll b |=({{k/key n/val} q/_a} (put(a q) k n)))
::
++ tap
^- (list {k/key n/val})
?~ a ~
[get tap(a pop)]
::
++ get :: retrieve top
^- {p/key q/val}
?~ a ~|(%empty-broq-peek !!)
?~ t.a [k n]:i.a
=+ m=get(a t.a)
?.((cmp k.i.a p.m) m [k n]:i.a)
::
++ uni :: merge
|= q/(broq key val)
^+ a
(meek (uniq a) (uniq q))
--
--
. ==
=| $: $0 ::
tym/{p/clok q/clok} :: positive+negative
== ::
|= {now/@da eny/@ ski/sley} :: current invocation
=| behn-state
=* state -
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
^?
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
|= $: hen=duct
type=*
wrapped-task=(hobo task:able)
==
^- {p/(list move) q/_..^$}
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%behn-call-soft (,@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%behn-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
==
=^ mof tym
?- -.q.hic
$rest
=. q.tym (~(put up q.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
^- [(list move) _..^$]
::
$wait
=. p.tym (~(put up p.tym) p.q.hic hen)
=. tym (raze tym)
[~ tym]
=/ =task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
((hard task:able) p.wrapped-task)
::
$wake
|- ^+ [*(list move) tym]
=. tym (raze tym)
?: =([~ ~] tym) [~ tym] :: XX TMI
?: =(~ p.tym)
~& %weird-wake [~ tym]
=+ nex=~(get up p.tym)
?: (lte now p.nex) [~ tym]
=^ mof tym $(p.tym ~(pop up p.tym))
[[`move`[q.nex %give %wake ~] mof] tym]
|^ =^ moves state
::
$wegh
:_ tym :_ ~
?- -.task
:: %crud: error report; hand off to %dill to be printed
::
%crud
[[hen %slip %d %flog task]~ state]
::
:: %born: handle urbit restart
::
%born
:: store this duct for setting unix wakeup timers
::
=. unix-duct hen
:: process any elapsed timers and clear and reset :next-wake
::
=^ moves timers notify-clients
(set-wake(next-wake ~) moves)
::
:: %rest: cancel a timer, resetting :next-wake if needed
::
%rest
=. timers (unset-timer [p.task hen])
(set-wake ~)
::
:: %wait: set a new timer
::
%wait
:: process elapsed timers first to maintain sort order
::
=^ moves timers notify-clients
:: set the timer, then adjust :next-wake if needed
::
=. timers (set-timer [p.task hen])
(set-wake moves)
::
:: %wake: unix says wake up; notify clients and set next wakeup
::
%wake
=^ moves timers notify-clients
(set-wake(next-wake ~) moves)
::
:: %wegh: produce memory usage report for |mass
::
%wegh
:_ state :_ ~
:^ hen %give %mass
:- %behn
:- %|
:~ tym+[%& tym]
:~ timers+[%& timers]
==
==
[mof ..^$]
:: reverse moves, since they were constructed backward, and return
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
?~ p.tym ~
(some p:[~(get up p.tym)])
[(flop moves) ..^^$]
:: +set-timer: set a timer, maintaining the sort order of the :timers list
::
++ set-timer
|= t=timer
^+ timers
::
?~ timers
~[t]
:: timers at the same date form a fifo queue
::
?: (lth date.t date.i.timers)
[t timers]
::
[i.timers $(timers t.timers)]
:: +unset-timer: cancel a timer; if it already expired, no-op
::
++ unset-timer
|= [t=timer]
^+ timers
:: if we don't have this timer, no-op; for debugging, add a printf here
::
?~ timers
~
?: =(i.timers t)
t.timers
::
[i.timers $(timers t.timers)]
:: +notify-clients: wake up vanes whose timers have expired
::
++ notify-clients
=| moves=(list move)
|- ^+ [moves timers]
::
?~ timers
[moves timers]
::
?: (gth date.i.timers now)
[moves timers]
::
%_ $
timers t.timers
moves [[duct.i.timers %give %wake ~] moves]
==
:: +set-wake: set or unset a unix timer to wake us when next timer expires
::
++ set-wake
|= moves=(list move)
^+ [moves state]
:: if no timers, cancel existing wakeup timer or no-op
::
?~ timers
?~ next-wake
[moves state]
:_ state(next-wake ~)
[[unix-duct %give %doze ~] moves]
:: if :next-wake is in the past or not soon enough, reset it
::
?^ next-wake
?: &((gte date.i.timers u.next-wake) (lte now u.next-wake))
[moves state]
:_ state(next-wake `date.i.timers)
[[unix-duct %give %doze `date.i.timers] moves]
:: there was no unix wakeup timer; set one
::
:_ state(next-wake `date.i.timers)
[[unix-duct %give %doze `date.i.timers] moves]
--
::
++ load
|= old/{$0 tym/{clok clok}}
|= old=*
^+ ..^$
..^$(tym tym.old)
?^ new=((soft behn-state) old)
~& %behn-load-new
..^$(state u.new)
~& %behn-load-wipe
..^$(state *behn-state)
:: +scry: view timer state
::
:: TODO: not referentially transparent w.r.t. elapsed timers,
:: which might or might not show up in the product
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
^- (unit (unit cage))
?. ?=(%& -.why) ~
=* who p.why
=+ ^= liz
|- ^- (list {@da duct})
=. tym (raze tym)
?~ p.tym ~
[~(get up p.tym) $(p.tym ~(pop up p.tym))]
[~ ~ %tank !>(>liz<)]
::
++ stay [%0 tym]
?. ?=(%& -.why)
~
[~ ~ %tank !>(>timers<)]
::
++ stay state
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
|= [tea=wire hen=duct hin=(hypo sign)]
^+ [*(list move) ..^$]
~| %behn-take-not-implemented
!!
--

388
sys/vane/clay.hoon
View File

@ -1,4 +1,3 @@
!:
:: clay (4c), revision control
::
:: This is split in three top-level sections: structure definitions, main
@ -181,7 +180,7 @@
::
:: Formal vane state.
::
:: -- `fat` is a collection of our domestic ships.
:: -- `rom` is our domestic state.
:: -- `hoy` is a collection of foreign ships where we know something about
:: their clay.
:: -- `ran` is the object store.
@ -193,7 +192,7 @@
:: -- `tip` is the date of the last write; if now, enqueue incoming requests.
::
++ raft :: filesystem
$: fat/(map ship room) :: domestic
$: rom/room :: domestic
hoy/(map ship rung) :: foreign
ran/rang :: hashes
mon/(map term beam) :: mount points
@ -331,19 +330,19 @@
++ move {p/duct q/(wind note gift:able)} :: local move
++ note :: out request $->
$% $: $a :: to %ames
$% {$want p/sock q/path r/*} ::
$% {$want p/ship q/path r/*} ::
== == ::
$: $c :: to %clay
$% {$info p/@p q/@tas r/nori} :: internal edit
{$merg p/@p q/@tas r/@p s/@tas t/case u/germ} :: merge desks
{$warp p/sock q/riff} ::
{$werp p/ship q/sock r/riff} ::
$% {$info q/@tas r/nori} :: internal edit
{$merg p/@tas q/@p r/@tas s/case t/germ:clay} :: merge desks
{$warp p/ship q/riff} ::
{$werp p/ship q/ship r/riff} ::
== == ::
$: $d ::
$% {$flog p/{$crud p/@tas q/(list tank)}} :: to %dill
== == ::
$: $f ::
$% [%build our=@p live=? schematic=schematic:ford] ::
$% [%build live=? schematic=schematic:ford] ::
== ==
$: $b ::
$% {$wait p/@da} ::
@ -389,25 +388,24 @@
::
:: The state includes:
::
:: -- local urbit `our`
:: -- current time `now`
:: -- current duct `hen`
:: -- local urbit `our`
:: -- all vane state `++raft` (rarely used, except for the object store)
:: -- target urbit `her`
:: -- target desk `syd`
:: -- all vane state `++raft` (rarely used, except for the object store)
::
:: For local desks, `our` == `her` is one of the urbits on our pier. For
:: foreign desks, `her` is the urbit the desk is on and `our` is the local
:: urbit that's managing the relationship with the foreign urbit. Don't mix
:: up those two, or there will be wailing and gnashing of teeth.
::
:: While setting up `++de`, we check if the given `her` is a local urbit. If
:: so, we pull the room from `fat` in the raft and get the desk information
:: from `dos` in there. Otherwise, we get the rung from `hoy` and get the
:: desk information from `rus` in there. In either case, we normalize the
:: desk information to a `++rede`, which is all the desk-specific data that
:: we utilize in `++de`. Because it's effectively a part of the `++de`
:: state, let's look at what we've got:
:: While setting up `++de`, we check if `our` == `her`. If so, we get
:: the desk information from `dos.rom`. Otherwise, we get the rung from
:: `hoy` and get the desk information from `rus` in there. In either case,
:: we normalize the desk information to a `++rede`, which is all the
:: desk-specific data that we utilize in `++de`. Because it's effectively
:: a part of the `++de` state, let's look at what we've got:
::
:: -- `lim` is the most recent date we're confident we have all the
:: information for. For local desks, this is always `now`. For foreign
@ -430,47 +428,44 @@
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
|%
++ de :: per desk
|= {now/@da hen/duct raft}
|= {{our/@p her/@p} syd/desk}
=* ruf +>+<+>
=+ ^- {hun/(unit duct) rede}
=+ rom=(~(get by fat.ruf) her)
?~ rom
|= [our=ship now=@da hen=duct raft]
|= [her=ship syd=desk]
:: XX ruf=raft crashes in the compiler
::
=* ruf |3.+6.^$
::
=+ ^- [hun=(unit duct) rede]
?. =(our her)
:: no duct, foreign +rede or default
::
:- ~
%+ fall
(~(get by rus:(fall (~(get by hoy.ruf) her) *rung)) syd)
:* lim=~2000.1.1
ref=[~ *rind]
qyx=~
dom=*dome
dok=~
mer=~
per=~
pew=~
==
:- `hun.u.rom
=+ jod=(fall (~(get by dos.u.rom) syd) *dojo)
:* lim=now
ref=~
qyx=qyx.jod
dom=dom.jod
dok=dok.jod
mer=mer.jod
per=per.jod
pew=pew.jod
==
=* red ->
=/ rus rus:(fall (~(get by hoy.ruf) her) *rung)
%+ fall (~(get by rus) syd)
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome dok=~ mer=~ per=~ pew=~]
:: administrative duct, domestic +rede
::
:- `hun.rom.ruf
=/ jod (fall (~(get by dos.rom.ruf) syd) *dojo)
[lim=now ref=~ [qyx dom dok mer per pew]:jod]
::
=* red=rede ->
=| mow/(list move)
|%
++ abet :: resolve
^- {(list move) raft}
:_ =+ rom=(~(get by fat.ruf) her)
?~ rom
=+ rug=(~(put by rus:(fall (~(get by hoy.ruf) her) *rung)) syd red)
^- [(list move) raft]
:- (flop mow)
?. =(our her)
:: save foreign +rede
::
=/ rus rus:(fall (~(get by hoy.ruf) her) *rung)
=/ rug (~(put by rus) syd red)
ruf(hoy (~(put by hoy.ruf) her rug))
=+ dos=(~(put by dos.u.rom) syd [qyx dom dok mer per pew])
ruf(fat (~(put by fat.ruf) her [(need hun) dos]))
(flop mow)
:: save domestic +room
::
%= ruf
hun.rom (need hun)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom dok mer per pew]:red)
==
::
:: Handle `%sing` requests
::
@ -621,7 +616,7 @@
(emit hen %give %writ ~ [p.mun q.mun syd] r.mun p.dat)
%- emit
:* hen %pass [%blab p.mun (scot q.mun) syd r.mun]
%f %build our live=%.n %pin
%f %build live=%.n %pin
(case-to-date q.mun)
(lobe-to-schematic:ze [her syd] r.mun p.dat)
==
@ -701,7 +696,7 @@
::
++ send-over-ames
|= {a/duct b/path c/ship d/{p/@ud q/riff}}
(emit a %pass b %a %want [our c] [%c %question p.q.d (scot %ud p.d) ~] q.d)
(emit a %pass b %a %want c [%c %question p.q.d (scot %ud p.d) ~] q.d)
::
:: Create a request that cannot be filled immediately.
::
@ -837,7 +832,7 @@
%- emit
^- move
:* hen %pass [%ergoing (scot %p her) syd ~] %f
%build our live=%.n %list
%build live=%.n %list
^- (list schematic:ford)
%+ turn `(list path)`mus
|= a/path
@ -1208,7 +1203,7 @@
^- (list move)
:~ :* hen %pass
[%inserting (scot %p her) syd (scot %da wen) ~]
%f %build our live=%.n %pin wen %list
%f %build live=%.n %pin wen %list
^- (list schematic:ford)
%+ turn ins.nuz
|= {pax/path mis/miso}
@ -1219,7 +1214,7 @@
==
:* hen %pass
[%diffing (scot %p her) syd (scot %da wen) ~]
%f %build our live=%.n %pin wen %list
%f %build live=%.n %pin wen %list
^- (list schematic:ford)
%+ turn dif.nuz
|= {pax/path mis/miso}
@ -1231,7 +1226,7 @@
==
:* hen %pass
[%castifying (scot %p her) syd (scot %da wen) ~]
%f %build our live=%.n %pin wen %list
%f %build live=%.n %pin wen %list
::~ [her syd %da wen] %tabl
^- (list schematic:ford)
%+ turn mut.nuz
@ -1402,7 +1397,7 @@
%- emit
:* hen %pass
[%mutating (scot %p her) syd (scot %da wen) ~]
%f %build our live=%.n %pin wen %list
%f %build live=%.n %pin wen %list
^- (list schematic:ford)
%+ turn cat
|= {pax/path cay/cage}
@ -1499,7 +1494,7 @@
^+ +>
%- emit
:* hen %pass [%patching (scot %p her) syd ~] %f
%build our live=%.n %list
%build live=%.n %list
^- (list schematic:ford)
%+ turn (sort ~(tap by hat) sort-by-head)
|= {a/path b/lobe}
@ -1586,7 +1581,7 @@
:: =- ~& %formed-ergo -
%- emit(dok ~)
:* hen %pass [%ergoing (scot %p her) syd ~] %f
%build our live=%.n %list
%build live=%.n %list
^- (list schematic:ford)
%+ turn ~(tap in sum)
|= a/path
@ -1760,7 +1755,7 @@
%- emit
:* hen %pass
[%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax]
%f %build our live=%.n %pin
%f %build live=%.n %pin
(case-to-date cas)
(vale-page [her syd] peg)
==
@ -1869,7 +1864,7 @@
%- emit
:* hen %pass
[%foreign-plops (scot %p our) (scot %p her) syd lum ~]
%f %build our live=%.n %pin (case-to-date cas)
%f %build live=%.n %pin (case-to-date cas)
%list
^- (list schematic:ford)
%+ turn ~(tap in pop)
@ -2756,12 +2751,13 @@
~
?- p.mun
$d
=+ rom=(~(get by fat.ruf) her)
?~ rom
~&(%null-rom-cd [~ ~])
:: XX this should only allow reads at the currebt date
::
?: !=(our her)
[~ ~]
?^ r.mun
~&(%no-cd-path [~ ~])
[~ ~ %& %noun !>(~(key by dos.u.rom))]
[~ ~ %& %noun !>(~(key by dos.rom.ruf))]
::
$p (read-p r.mun)
$t (bind (read-t yon r.mun) (lift |=(a=cage [%& a])))
@ -2927,8 +2923,7 @@
%- emit(wat.dat %ali)
:* hen %pass
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ali ~]
%c %warp [p.bob p.ali] q.ali
`[%sing %v cas.dat /]
[%c %warp p.ali q.ali `[%sing %v cas.dat /]]
==
::
:: Parse the state of ali's desk, and get the most recent commit.
@ -3172,7 +3167,7 @@
:* hen %pass
=+ (cat 3 %diff- nam)
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~]
%f %build p.bob live=%.n %pin (case-to-date r.oth) %list
%f %build live=%.n %pin (case-to-date r.oth) %list
^- (list schematic:ford)
%+ murn ~(tap by q.bas.dat)
|= {pax/path lob/lobe}
@ -3301,7 +3296,7 @@
%- emit(wat.dat %merge)
:* hen %pass
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %merge ~]
%f %build p.bob live=%.n %list
%f %build live=%.n %list
^- (list schematic:ford)
%+ turn ~(tap by (~(int by can.dal.dat) can.dob.dat))
|= {pax/path *}
@ -3341,7 +3336,7 @@
%- emit(wat.dat %build)
:* hen %pass
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %build ~]
%f %build p.bob live=%.n %list
%f %build live=%.n %list
^- (list schematic:ford)
%+ murn ~(tap by bof.dat)
|= {pax/path cay/(unit cage)}
@ -3487,7 +3482,7 @@
%- emit(wat.dat %checkout)
:* hen %pass
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %checkout ~]
%f %build p.bob live=%.n %pin (case-to-date r.val) %list
%f %build live=%.n %pin (case-to-date r.val) %list
:: ~ val %tabl
^- (list schematic:ford)
%+ murn ~(tap by q.new.dat)
@ -3545,7 +3540,7 @@
%- emit(wat.dat %ergo)
:* hen %pass
[%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali %ergo ~]
%f %build p.bob live=%.n %pin (case-to-date r.val) %list
%f %build live=%.n %pin (case-to-date r.val) %list
^- (list schematic:ford)
%+ turn ~(tap in sum)
|= a/path
@ -3688,7 +3683,7 @@
:: This is the arvo interface vane. Our formal state is a `++raft`, which
:: has five components:
::
:: -- `fat` is the state for all local desks.
:: -- `rom` is the state for all local desks.
:: -- `hoy` is the state for all foreign desks.
:: -- `ran` is the global, hash-addressed object store.
:: -- `mon` is the set of mount points in unix.
@ -3699,28 +3694,21 @@
$: $1 :: vane version
ruf/raft :: revision tree
== ::
|= {now/@da eny/@ ski/sley} :: activate
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
^? :: opaque core
|% ::
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
|= $: hen=duct
type=*
wrapped-task=(hobo task:able)
==
=* req q.hic
=> %= . :: XX temporary
req
^- task:able
?: ?=($soft -.req)
=+
~|([%bad-soft (@t -.p.req)] ((soft task:able) p.req))
?~ -
~& [%bad-softing (@t -.p.req)] !!
u.-
?: (~(nest ut -:!>(*task:able)) | p.hic) req
~& [%clay-call-flub (@tas `*`-.req)]
((hard task:able) req)
==
^+ [p=*(list move) q=..^$]
::
=/ req=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
((hard task:able) p.wrapped-task)
::
^+ [*(list move) ..^$]
?- -.req
$boat
:_ ..^$
@ -3732,11 +3720,10 @@
(~(put by cez.ruf) nom.req cew.req)
:: wake all desks, a request may have been affected.
=| mos/(list move)
=+ rom=(fall (~(get by fat.ruf) our.req) *room)
=+ des=~(tap in ~(key by dos.rom))
=/ des ~(tap in ~(key by dos.rom.ruf))
|-
?~ des [[[hen %give %mack ~] mos] ..^^$]
=+ den=((de now hen ruf) [. .]:our.req i.des)
=/ den ((de our now hen ruf) our i.des)
=^ mor ruf
=< abet:wake
?: ?=(^ cew.req) den
@ -3747,8 +3734,7 @@
[[hen %give %cruz cez.ruf]~ ..^$]
::
$crow
=+ rom=(fall (~(get by fat.ruf) our.req) *room)
=+ des=~(tap by dos.rom)
=/ des ~(tap by dos.rom.ruf)
=| rus/(map desk {r/regs w/regs})
|^
?~ des [[hen %give %croz rus]~ ..^^$]
@ -3766,10 +3752,13 @@
|= {p/path r/rule}
(~(has in who.r) |+nom.req)
--
::
$crud
[[[hen %slip %d %flog req] ~] ..^$]
::
$drop
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our.req des.req)
=/ den ((de our now hen ruf) our des.req)
abet:drop-me:den
[mos ..^$]
::
@ -3788,25 +3777,12 @@
?: =(%$ des.req)
[~ ..^$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our.req des.req)
=/ den ((de our now hen ruf) our des.req)
abet:(edit:den now dit.req)
[mos ..^$]
::
$init
:_ %_ ..^$
fat.ruf
?< (~(has by fat.ruf) our.req)
(~(put by fat.ruf) our.req [-(hun hen)]:[*room .])
==
^- (list move)
?: ?=(%czar (clan:title our.req))
~
=/ bos=ship
;; ship
%- need %- need
%- (sloy ski)
[[151 %noun] %j (en-beam:format [our.req %sein da+now] /(scot %p our.req))]
[hen %pass /init-merge %c %merg our.req %base bos %kids da+now %init]~
[~ ..^$(hun.rom.ruf hen)]
::
$into
=. hez.ruf `hen
@ -3817,11 +3793,8 @@
=+ ^- bem/beam
?^ bem
u.bem
[[?>(?=(^ fat.ruf) p.n.fat.ruf) %base %ud 1] ~]
=+ rom=(~(get by fat.ruf) p.bem)
?~ rom
~
=+ dos=(~(get by dos.u.rom) q.bem)
[[our %base %ud 1] ~]
=/ dos (~(get by dos.rom.ruf) q.bem)
?~ dos
~
?: =(0 let.dom.u.dos)
@ -3833,18 +3806,18 @@
?=($mime p.p.b)
?=({$hoon ~} (slag (dec (lent a)) a))
==
:~ [hen %pass /one %c %info p.bem q.bem %& one]
[hen %pass /two %c %info p.bem q.bem %& two]
:~ [hen %pass /one %c %info q.bem %& one]
[hen %pass /two %c %info q.bem %& two]
==
=+ yak=(~(got by hut.ran.ruf) (~(got by hit.dom.u.dos) let.dom.u.dos))
=+ cos=(mode-to-soba q.yak (flop s.bem) all.req fis.req)
[hen %pass /both %c %info p.bem q.bem %& cos]~
[hen %pass /both %c %info q.bem %& cos]~
::
$merg :: direct state up
?: =(%$ des.req)
[~ ..^$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our.req des.req)
=/ den ((de our now hen ruf) our des.req)
abet:abet:(start:(me:ze:den [her.req dem.req] ~ &) cas.req how.req)
[mos ..^$]
::
@ -3857,14 +3830,11 @@
=* bem bem.req
=. mon.ruf
(~(put by mon.ruf) des.req [p.bem q.bem r.bem] s.bem)
=+ yar=(~(get by fat.ruf) p.bem)
?~ yar
[~ ..^$]
=+ dos=(~(get by dos.u.yar) q.bem)
=/ dos (~(get by dos.rom.ruf) q.bem)
?~ dos
[~ ..^$]
=^ mos ruf
=+ den=((de now hen ruf) [. .]:p.bem q.bem)
=/ den ((de our now hen ruf) p.bem q.bem)
abet:(mont:den des.req bem)
[mos ..^$]
::
@ -3902,24 +3872,26 @@
::
$perm
=^ mos ruf
::TODO after new boot system, just use our from global.
=+ den=((de now hen ruf) [. .]:our.req des.req)
=/ den ((de our now hen ruf) our des.req)
abet:(perm:den pax.req rit.req)
[mos ..^$]
::
$sunk [~ ..^$]
::
?($warp $werp)
:: capture whether this read is on behalf of another ship
:: for permissions enforcement
::
=^ for req
?: ?=($warp -.req)
[~ req]
:_ [%warp wer.req rif.req]
?: =(who.req p.wer.req) ~
`who.req
:- ?:(=(our who.req) ~ `who.req)
[%warp wer.req rif.req]
::
?> ?=($warp -.req)
=* rif rif.req
=^ mos ruf
=+ den=((de now hen ruf) wer.req p.rif)
=/ den ((de our now hen ruf) wer.req p.rif)
=< abet
?~ q.rif
cancel-request:den
@ -3937,16 +3909,15 @@
=+ ryf=((hard riff) res.req)
:_ ..^$
:~ [hen %give %mack ~]
:- hen
:^ %pass [(scot %p p.wer) (scot %p q.wer) t.pax]
%c
[%werp q.wer [p.wer p.wer] ryf]
=/ =wire
[(scot %p our) (scot %p wer) t.pax]
[hen %pass wire %c %werp wer our ryf]
==
?> ?=({$answer @ @ ~} pax)
=+ syd=(slav %tas i.t.pax)
=+ inx=(slav %ud i.t.t.pax)
=^ mos ruf
=+ den=((de now hen ruf) wer syd)
=/ den ((de our now hen ruf) wer syd)
abet:(take-foreign-update:den inx ((hard (unit rand)) res.req))
[[[hen %give %mack ~] mos] ..^$]
::
@ -3955,7 +3926,7 @@
:^ hen %give %mass
:- %clay
:- %|
:~ domestic+[%& fat.ruf]
:~ domestic+[%& rom.ruf]
foreign+[%& hoy.ruf]
:- %object-store :- %|
:~ commits+[%& hut.ran.ruf]
@ -3964,88 +3935,13 @@
==
==
::
:: All timers are handled by `%behn` nowadays.
++ doze
|= {now/@da hen/duct}
^- (unit @da)
~
::
++ load
=> |%
++ rove-0
$% {$sing p/mood}
{$next p/mood q/cach}
$: $mult
p/mool
q/(unit aeon)
r/(map (pair care path) cach)
s/(map (pair care path) cach)
==
{$many p/? q/moat r/(map path lobe)}
==
++ wove-0 (cork wove |=(a/wove a(q (rove-0 q.a))))
++ cult-0 (jug wove-0 duct)
++ 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 $%({$1 ruf/raft} {$0 ruf/raft-0})
++ axle $%([%1 ruf=raft])
--
|= old/axle
|= old=axle
^+ ..^$
?- -.old
$1
..^$(ruf ruf.old)
::
$0
|^
=- ^$(old [%1 -])
=+ ruf.old
:* (~(run by fat) rom)
(~(run by hoy) run)
ran mon hez ~ ~ *@da
==
::
++ wov
|= a/wove-0
^- wove
:- p.a
?. ?=($next -.q.a) q.a
[%next p.q.a ~ q.q.a]
::
++ cul
|= a/cult-0
^- cult
%- ~(gas by *cult)
%+ turn ~(tap by a)
|= {p/wove-0 q/(set duct)}
[(wov p) q]
::
++ rom
|= room-0
^- room
:- hun
%- ~(run by dos)
|= d/dojo-0
^- dojo
d(qyx (cul qyx.d))
::
++ run
|= a/rung-0
=- a(rus (~(run by rus.a) -))
|= r/rede-0
^- rede
r(qyx (cul qyx.r))
--
==
::
++ scry :: inspect
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
@ -4054,7 +3950,6 @@
=* his p.why
:: ~& scry+[ren `path`[(scot %p his) syd ~(rent co lot) tyl]]
:: =- ~& %scry-done -
=+ got=(~(has by fat.ruf) his)
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
?~ luk [~ ~]
?: =(%$ ren)
@ -4069,7 +3964,7 @@
?: ?=(%| -.m) ~
?: =(p.m his) ~
`p.m
=+ den=((de now [/scryduct ~] ruf) [. .]:his syd)
=/ den ((de our now [/scryduct ~] ruf) his syd)
=+ (aver:den for u.run u.luk tyl)
?~ - -
?~ u.- -
@ -4079,23 +3974,19 @@
++ stay [%1 ruf]
++ take :: accept response
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
^+ [*(list move) ..^$]
?: ?=({$merge @ @ @ @ @ ~} tea)
?> ?=(?($writ $made) +<.q.hin)
=+ our=(slav %p i.t.tea)
=* syd i.t.t.tea
=+ her=(slav %p i.t.t.t.tea)
=* sud i.t.t.t.t.tea
=* sat i.t.t.t.t.t.tea
=+ dat=?-(+<.q.hin $writ [%& p.q.hin], $made [%| result.q.hin])
=+ ^- kan/(unit dome)
%+ biff (~(get by fat.ruf) her)
|= room
%+ bind (~(get by dos) sud)
|= dojo
dom
=/ kan=(unit dome)
%+ bind (~(get by dos.rom.ruf) sud)
|=(a=dojo dom.a)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:abet:(route:(me:ze:den [her sud] kan |) sat dat)
[mos ..^$]
?: ?=({$blab care @ @ *} tea)
@ -4122,76 +4013,68 @@
?+ -.tea !!
$inserting
?> ?=({@ @ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-inserting:den wen result.q.hin)
[mos ..^$]
::
$diffing
?> ?=({@ @ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-diffing:den wen result.q.hin)
[mos ..^$]
::
$castifying
?> ?=({@ @ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-castify:den wen result.q.hin)
[mos ..^$]
::
$mutating
?> ?=({@ @ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=+ wen=(slav %da i.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-mutating:den wen result.q.hin)
[mos ..^$]
::
$patching
?> ?=({@ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-patch:den result.q.hin)
[mos ..^$]
::
$ergoing
?> ?=({@ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ syd=(slav %tas i.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [. .]:our syd)
=/ den ((de our now hen ruf) our syd)
abet:(take-ergo:den result.q.hin)
[mos ..^$]
::
$foreign-plops
?> ?=({@ @ @ @ ~} t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=* syd i.t.t.t.tea
=+ lem=(slav %da i.t.t.t.t.tea)
=^ mos ruf
=+ den=((de now hen ruf) [our her] syd)
=/ den ((de our now hen ruf) her syd)
abet:(take-foreign-plops:den ?~(lem ~ `lem) result.q.hin)
[mos ..^$]
::
$foreign-x
?> ?=({@ @ @ @ @ *} t.tea)
=+ our=(slav %p i.t.tea)
=+ her=(slav %p i.t.t.tea)
=+ syd=(slav %tas i.t.t.t.tea)
=+ car=((hard care) i.t.t.t.t.tea)
@ -4201,7 +4084,7 @@
->+
=* pax t.t.t.t.t.t.tea
=^ mos ruf
=+ den=((de now hen ruf) [our her] syd)
=/ den ((de our now hen ruf) her syd)
abet:(take-foreign-x:den car cas pax result.q.hin)
[mos ..^$]
==
@ -4229,23 +4112,18 @@
?> =(hen queued-duct)
::
(call hen [-:!>(*task:able) queued-task])
:: =+ dal=(turn ~(tap by fat.ruf) |=([a=@p b=room] a))
:: =| mos=(list move)
:: |- ^- [p=(list move) q=_..^^$]
:: ?~ dal [mos ..^^$]
:: =+ une=(un i.dal now hen ruf)
:: =^ som une wake:une
:: $(dal t.dal, ruf abet:une, mos (weld som mos))
:: =^ mos=(list move) une
:: wake:(un our now hen ruf)
:: [mos ..^^$]
::
$writ
?> ?=({@ @ *} tea)
~| i=i.tea
~| it=i.t.tea
=+ our=(slav %p i.tea)
=+ him=(slav %p i.t.tea)
:_ ..^$
:~ :* hen %pass /writ-want %a
%want [our him] [%c %answer t.t.tea]
%want him [%c %answer t.t.tea]
(bind p.+.q.hin rant-to-rand)
==
==

120
sys/vane/dill.hoon
View File

@ -1,4 +1,3 @@
!:
::
:: dill (4d), terminal handling
::
@ -11,7 +10,6 @@
++ all-axle ?(axle) ::
++ axle ::
$: $0 ::
ore/(unit ship) :: identity once set
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
$= hef :: other weights
@ -43,10 +41,10 @@
$% {$wegh $~} ::
== ::
++ note-clay ::
$% {$merg p/@p q/@tas r/@p s/@tas t/case u/germ:clay}:: merge desks
{$warp p/sock q/riff:clay} :: wait for clay hack
$% {$merg p/@tas q/@p r/@tas s/case t/germ:clay} :: merge desks
{$warp p/ship q/riff:clay} :: wait for clay hack
{$wegh $~} ::
{$perm p/ship q/desk r/path s/rite:clay} :: change permissions
{$perm p/desk q/path r/rite:clay} :: change permissions
== ::
++ note-dill :: note to self, odd
$% {$crud p/@tas q/(list tank)} ::
@ -54,8 +52,7 @@
{$init p/ship} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
{$vega p/path q/path} :: reboot by path
{$velo p/@t q/@t} :: reboot by path
{$vega p/@t q/@t} :: reboot by path
{$verb $~} :: verbose mode
== ::
++ note-eyre ::
@ -137,13 +134,11 @@
:::::::: :: dill tiles
--
=| all/axle
|= {now/@da eny/@ ski/sley} :: current invocation
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
=> |%
++ as :: per cause
=| moz/(list move)
|_ $: {hen/duct our/ship}
axon
==
|_ [hen=duct axon]
++ abet :: resolve
^- {(list move) axle}
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
@ -163,7 +158,6 @@
$heft heft
$veer (dump kyz)
$vega (dump kyz)
$velo (dump kyz)
$verb (dump kyz)
==
::
@ -295,8 +289,8 @@
|= who=ship
;; ship
%- need %- need
%- (sloy ski)
[[151 %noun] %j (en-beam:format [our %sein da+now] /(scot %p who))]
%- (sloy-light ski)
[[151 %noun] %j our %sein da+now /(scot %p who)]
::
++ init :: initialize
~& [%dill-init our ram]
@ -304,15 +298,14 @@
=/ myt (flop (need tem))
=/ can (clan:title our)
=. tem ~
=. moz :_(moz [hen %pass / %c %merg our %home our %base da+now %init])
=. moz :_(moz [hen %pass / %c %merg %home our %base da+now %init])
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
=. +> (sync %home our %base)
=. +> ?: ?=(?($czar $pawn) can) +>
(sync %base (sein our) %kids)
=. +> ?: ?=(?($czar $pawn) can)
(sync %home our %base)
(init-sync %home our %base)
=. +> ?. ?=(?($duke $king $czar) can) +>
:: make kids desk publicly readable, so syncs work.
::
(show %kids):(sync %kids our %base)
=. +> autoload
=. +> peer
@ -326,12 +319,7 @@
tem `(turn gyl |=(a/gill [%yow a]))
moz
:_ moz
:* hen
%pass
/
%c
[%warp [our our] %base `[%sing %y [%ud 1] /]]
==
[hen %pass / %c %warp our %base `[%sing %y [%ud 1] /]]
==
::
++ send :: send action
@ -354,9 +342,7 @@
%_ +>.$
moz
:_ moz
:* hen %pass /show %c %perm our
des / r+`[%black ~]
==
[hen %pass /show %c %perm des / r+`[%black ~]]
==
::
++ sync
@ -369,16 +355,6 @@
==
==
::
++ init-sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /init-sync %g %deal [our our]
ram %poke %hood-init-sync -:!>(syn) syn
==
==
::
++ autoload
%_ .
moz
@ -455,7 +431,7 @@
^- mass
:- %dill
:- %|
:~ all+[%& [ore hey dug]:all]
:~ all+[%& [hey dug]:all]
==
::
++ wegt
@ -487,90 +463,74 @@
++ ax :: make ++as
|= hen/duct
^- (unit _as)
?~ ore.all ~
=/ nux (~(get by dug.all) hen)
?~ nux ~
(some ~(. as [hen u.ore.all] u.nux))
(some ~(. as hen u.nux))
--
|% :: poke+peek pattern
++ call :: handle request
|= $: hen/duct
hic/(hypo (hobo task:able))
==
^+ [p=*(list move) q=..^$]
=> %= . :: XX temporary
q.hic
^- task:able
?: ?=($soft -.q.hic)
:: ~& [%dill-call-soft (@tas `*`-.p.q.hic)]
((hard task:able) p.q.hic)
?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic
~& [%dill-call-flub (@tas `*`-.q.hic)]
((hard task:able) q.hic)
|= $: hen=duct
type=*
wrapped-task=(hobo task:able)
==
^+ [*(list move) ..^$]
=/ task=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
((hard task:able) p.wrapped-task)
:: the boot event passes thru %dill for initial duct distribution
::
?: ?=(%boot -.q.hic)
?> ?=(?(%dawn %fake) -.p.q.hic)
?: ?=(%boot -.task)
?> ?=(?(%dawn %fake) -.p.task)
?> =(~ hey.all)
=. hey.all `hen
=/ boot ((soft note-jael) p.q.hic)
=/ boot ((soft note-jael) p.task)
?~ boot
~| invalid-boot-event+hen !!
:_(..^$ [hen %pass / %j u.boot]~)
:: we are subsequently initialized. single-home
::
?: ?=(%init -.q.hic)
?: ?=(%init -.task)
?> =(~ dug.all)
?> =(~ ore.all)
=. ore.all `p.q.hic
:: configure new terminal, setup :hood and %clay
::
=* our p.q.hic
=* duc (need hey.all)
=/ app %hood
=/ see (tuba "<awaiting {(trip app)}, this may take a few minutes>")
=/ see (tuba "<awaiting {(trip app)}, this may take a minute>")
=/ zon=axon [app input=[~ ~] width=80 cursor=0 see]
::
=^ moz all abet:(~(into as [duc our] zon) ~)
=^ moz all abet:(~(into as duc zon) ~)
[moz ..^$]
:: %flog tasks are unwrapped and sent back to us on our default duct
::
?: ?=(%flog -.q.hic)
?: ?=(%flog -.task)
?~ hey.all
[~ ..^$]
:: this lets lib/helm send %heft a la |mass
::
=/ not=note-dill
?:(?=([%crud %hax-heft ~] p.q.hic) [%heft ~] p.q.hic)
?:(?=([%crud %hax-heft ~] p.task) [%heft ~] p.task)
[[u.hey.all %slip %d not]~ ..^$]
:: a %sunk notification from %jail comes in on an unfamiliar duct
::
?: ?=(%sunk -.q.hic)
?: ?=(%sunk -.task)
[~ ..^$]
::
=/ nus (ax hen)
?~ nus
:: we got this on an unknown duct or
:: before %boot or %init (or one of those crashed)
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
::
~& [%dill-call-no-flow hen -.q.hic]
=/ tan ?:(?=(%crud -.q.hic) q.q.hic ~)
~& [%dill-call-no-flow hen -.task]
=/ tan ?:(?=(%crud -.task) q.task ~)
[((slog (flop tan)) ~) ..^$]
::
=^ moz all abet:(call:u.nus q.hic)
=^ moz all abet:(call:u.nus task)
[moz ..^$]
::
++ doze
|= {now/@da hen/duct}
^- (unit @da)
~
::
++ load :: trivial
|= old/all-axle
..^$(all old)
:: |= old=* :: diable
:: ..^$(ore.all `~zod)
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
@ -583,11 +543,11 @@
::
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [p=*(list move) q=..^$]
^+ [*(list move) ..^$]
=/ nus (ax hen)
?~ nus
:: we got this on an unknown duct or
:: before %boot or %init (or one of those crashed)
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
::
~& [%dill-take-no-flow hen -.q.hin +<.q.hin]
[~ ..^$]

Some files were not shown because too many files have changed in this diff Show More