diff --git a/.travis.yml b/.travis.yml index 0c4d36153..4da03fd5a 100644 --- a/.travis.yml +++ b/.travis.yml @@ -4,11 +4,9 @@ node_js: before_install: - cd .travis # keep main directory clear - - > - wget $(cat ./pin-urbit-release.url)/urbit -O ./urbit && - chmod +x ./urbit; - echo "FIXME downloaded raw urbit binary releaseinstead of .deb"; - echo "FIXME used full pinned url instead of tag name" + - wget -i pin-urbit-release.url -O ./urbit.deb + - sudo apt install ./urbit.deb + before_script: bash get-or-build-pill.sh diff --git a/.travis/get-or-build-pill.sh b/.travis/get-or-build-pill.sh index 76b9d78d8..f5ad1df57 100644 --- a/.travis/get-or-build-pill.sh +++ b/.travis/get-or-build-pill.sh @@ -45,7 +45,7 @@ do require! <[ stream-snitch once recursive-copy wait-on ]> pty = require \pty.js - urbit = pty.spawn './urbit' <[-FI zod prev/zod]> + urbit = pty.spawn 'urbit' <[-FI zod prev/zod]> .on \data -> process.stdout.write it on-next = (re,cb)-> diff --git a/.travis/pin-urbit-release.url b/.travis/pin-urbit-release.url index 9ff2d562b..560ece0e3 100644 --- a/.travis/pin-urbit-release.url +++ b/.travis/pin-urbit-release.url @@ -1 +1 @@ -https://github.com/urbit/urbit/releases/download/redefault-0.5.1 +https://github.com/urbit/urbit/releases/download/v0.5.1/urbit_0.5-1_amd64.deb diff --git a/.travis/test.ls b/.travis/test.ls index 5c4e767c1..02eb5c369 100644 --- a/.travis/test.ls +++ b/.travis/test.ls @@ -3,7 +3,7 @@ pty = require \pty.js urbit = # TODO abort on failure - pty.spawn './urbit' <[-B urbit.pill -A .. -cFI zod zod]> + pty.spawn 'urbit' <[-B urbit.pill -A .. -cFI zod zod]> .on \data -> process.stdout.write it urbit.on \exit (code)-> diff --git a/app/ask.hoon b/app/ask.hoon index 8d390342c..dba60eb13 100644 --- a/app/ask.hoon +++ b/app/ask.hoon @@ -7,7 +7,7 @@ |% ++ card $% {$diff $sole-effect sole-effect} - {$poke wire {ship $hood} $womb-invite {cord:hood-womb invite:hood-womb}} + {$poke wire {ship $hood} $womb-invite ,=,(hood-womb {cord reference invite})} == ++ invited ?($new $sent $ignored) ++ email @t @@ -154,7 +154,8 @@ ^- card :^ %poke /invite/(scot %t ask) [(need wom) %hood] :- %womb-invite - ^- [cord:hood-womb invite:hood-womb] + =, hood-womb + ^- [cord reference invite] =+ inv=(scot %uv (end 7 1 eny.bow)) - [inv [ask 1 0 "You have been invited to Urbit: {(trip inv)}" ""]] + [inv ~ [ask 1 0 "You have been invited to Urbit: {(trip inv)}" ""]] -- diff --git a/app/dojo.hoon b/app/dojo.hoon index 657057f4a..d709a9b4f 100644 --- a/app/dojo.hoon +++ b/app/dojo.hoon @@ -549,7 +549,7 @@ $tang ;;(tang q.q.cay) $httr =+ hit=;;(httr:eyre q.q.cay) - =- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '')))) + =- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '' ~)))) :- "HTTP {}" %+ weld (turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}")) diff --git a/app/hall.hoon b/app/hall.hoon index 0e8096dfa..b5ff955d8 100644 --- a/app/hall.hoon +++ b/app/hall.hoon @@ -11,6 +11,11 @@ /- hall :: structures /+ hall, hall-legacy :: libraries /= seed /~ !>(.) +/= filter-gram + /^ $-({telegram:hall bowl:gall} telegram:hall) + /| /: /%/filter /!noun/ + /~ |=({t/telegram:hall bowl:gall} t) + == :: :::: :: @@ -25,9 +30,9 @@ :> state data structures +| ++ state :> application state - $: stories/(map naem story) :< conversations + $: stories/(map name story) :< conversations outbox/(map serial tracking) :< sent messages - log/(map naem @ud) :< logged to clay + log/(map name @ud) :< logged to clay nicks/(map ship nick) :< local nicknames binds/(jug char audience) :< circle glyph lookup public/(set circle) :< publicly member of @@ -63,13 +68,13 @@ {$glyph diff-glyph} :< un/bound glyph {$nick diff-nick} :< changed nickname :: story state :: - {$story nom/naem det/delta-story} :< change to story + {$story nom/name det/delta-story} :< change to story :: side-effects :: {$init $~} :< initialize {$observe who/ship} :< watch burden bearer $: $present :> send %present cmd hos/ship :: - nos/(set naem) :: + nos/(set name) :: dif/diff-status :: == :: == :: @@ -103,7 +108,7 @@ == :: ++ weir :> parsed wire $% {$repeat cir/circle ses/(list serial)} :< messaging wire - {$circle nom/naem src/source} :< subscription wire + {$circle nom/name src/source} :< subscription wire == :: -- :: @@ -112,7 +117,7 @@ :> # :> functional cores and arms. :: -|_ {bol/bowl:gall state} +|_ {bol/bowl:gall $0 state} :: :> # %transition :> prep transition @@ -120,12 +125,20 @@ ++ prep :> adapts state. :: - |= old/(unit state) + => |% + ++ states + $%({$0 s/state}) + -- + =| mos/(list move) + |= old/(unit states) ^- (quip move _..prep) ?~ old %- pre-bake ta-done:ta-init:ta - [~ ..prep(+<+ u.old)] + ?- -.u.old + $0 + [mos ..prep(+<+ u.old)] + == :: :> # %engines :> main cores. @@ -174,13 +187,27 @@ |= des/(list delta) %_(+> deltas (welp (flop des) deltas)) :: - ++ ta-note - :> sends {msg} as an %app message to the user's inbox. + ++ ta-speak + :> sends {sep} as an %app message to the user's inbox. :: - |= msg/tape + |= sep/speech %+ ta-action %phrase :- [[our.bol %inbox] ~ ~] - [%app dap.bol %lin | (crip msg)]~ + [%app dap.bol sep]~ + :: + ++ ta-grieve + :> sends a stack trace to the user's inbox. + :: + |= {msg/tape fal/tang} + %^ ta-speak %fat + [%name 'stack trace' %tank fal] + [%lin | (crip msg)] + :: + ++ ta-note + :> sends {msg} to the user's inbox. + :: + |= msg/tape + (ta-speak %lin | (crip msg)) :: ++ ta-evil :> tracing printf and crash. @@ -202,7 +229,7 @@ :> {nom} exists, calls the gate with a story core. :> if it doesn't, does nothing. :: - |= nom/naem + |= nom/name |= fun/$-(_so _ta) ^+ +>+> =+ pur=(~(get by stories) nom) @@ -224,11 +251,11 @@ :: :: create default circles. => %+ roll - ^- (list {security naem cord}) + ^- (list {security name cord}) :~ [%mailbox %inbox 'default home'] [%journal %public 'visible activity'] == - |= {{typ/security nom/naem des/cord} _ta} + |= {{typ/security nom/name des/cord} _ta} (ta-action [%create nom des typ]) %- ta-deltas :: if needed, subscribe to our parent's /burden. @@ -246,15 +273,15 @@ |= {src/ship cod/command} ^+ +> ?- -.cod - ::> %publish commands prompt us (as a circle host) - ::> to verify and distribute messages. + :: %publish commands prompt us (as a circle host) + :: to verify and distribute messages. $publish (ta-think | src +.cod) - ::> %present commands are used to ask us to set - ::> someone's status in the indicated stories. + :: %present commands are used to ask us to set + :: someone's status in the indicated stories. $present (ta-present src +.cod) - ::> %bearing commands are used by our children to - ::> let us know they're bearing our /burden. we - ::> need to watch them to allow changes to go up. + :: %bearing commands are used by our children to + :: let us know they're bearing our /burden. we + :: need to watch them to allow changes to go up. $bearing (ta-observe src) ::TODO isn't this redundant with ta-subscribe? == :: @@ -264,7 +291,7 @@ :> sets status for the indicated stories, :> but only if they have write permission there. :: - |= {who/ship nos/(set naem) dif/diff-status} + |= {who/ship nos/(set name) dif/diff-status} ^+ +> =+ nol=~(tap in nos) |- @@ -297,11 +324,13 @@ ?- -.act :: circle configuration $create (action-create +.act) + $design (action-design +.act) $source (action-source +.act) $depict (action-depict +.act) $filter (action-filter +.act) $permit (action-permit +.act) $delete (action-delete +.act) + $usage (action-usage +.act) :: messaging $convey (action-convey +.act) $phrase (action-phrase +.act) @@ -321,7 +350,7 @@ :> store a delta about a story. if the story :> does not exist, crash. :: - |= {nom/naem det/delta-story} + |= {nom/name det/delta-story} ?: (~(has by stories) nom) (impact nom det) (ta-evil (crip "no story {(trip nom)}")) @@ -331,7 +360,7 @@ :> :> Store a delta about a story. :: - |= {nom/naem det/delta-story} + |= {nom/name det/delta-story} (ta-delta %story nom det) :: ++ present @@ -340,18 +369,17 @@ |= {aud/audience dif/diff-status} ^+ ..ta-action =/ cic - ^- (jug ship naem) + ^- (jug ship name) %- ~(rep in aud) - |= {c/circle m/(jug ship naem)} + |= {c/circle m/(jug ship name)} (~(put ju m) hos.c nom.c) =? ..ta-action (~(has by cic) our.bol) - %- ~(rep in (~(get ju cic) our.bol)) - |= {n/naem _ta} :: beware, urbit/arvo#447 - (affect n %status [our.bol n] our.bol dif) + =+ nos=~(tap in (~(get ju cic) our.bol)) + (ta-present our.bol (~(get ju cic) our.bol) dif) =. cic (~(del by cic) our.bol) %- ta-deltas %- ~(rep by cic) - |= {{h/ship s/(set naem)} l/(list delta)} + |= {{h/ship s/(set name)} l/(list delta)} :_ l [%present h s dif] :: @@ -360,12 +388,13 @@ ++ action-create :> creates a story with the specified parameters. :: - |= {nom/naem des/cord typ/security} + |= {nom/name des/cord typ/security} ^+ ..ta-action ?. (~(has in stories) nom) %^ impact nom %new :* [[[our.bol nom] ~] ~ ~] des + ~ *filter :- typ ?. ?=(?($village $journal) typ) ~ @@ -373,13 +402,21 @@ == (ta-evil (crip "{(trip nom)}: already exists")) :: + ++ action-design + :> creates a story with the specified config. + :: + |= {nom/name cof/config} + ?. (~(has in stories) nom) + (impact nom %new cof) + (ta-evil (crip "{(trip nom)}: already exists")) + :: ++ action-delete :> delete + announce :> :> delete story {nom}, optionally announcing the :> event with message {mes}. :: - |= {nom/naem mes/(unit cord)} + |= {nom/name mes/(unit cord)} ^+ ..ta-action =? ..ta-action ?=(^ mes) %+ action-phrase @@ -390,7 +427,7 @@ ++ action-depict :> change description of story {nom} to {des}. :: - |= {nom/naem cap/cord} + |= {nom/name cap/cord} (affect nom %config [our.bol nom] %caption cap) :: ++ action-filter @@ -399,13 +436,13 @@ :> replaces the story's current filter with the :> specified one. :: - |= {nom/naem fit/filter} + |= {nom/name fit/filter} (affect nom %config [our.bol nom] %filter fit) :: ++ action-permit :> invite to/banish from story {nom} all {sis}. :: - |= {nom/naem inv/? sis/(set ship)} + |= {nom/name inv/? sis/(set ship)} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) @@ -414,12 +451,21 @@ ++ action-source :> add/remove {pos} as sources for story {nom}. :: - |= {nom/naem sub/? srs/(set source)} + |= {nom/name sub/? srs/(set source)} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) so-done:(~(so-sources so nom ~ u.soy) sub srs) :: + ++ action-usage + :> add or remove usage tags. + :: + |= {nom/name add/? tas/tags} + =+ soy=(~(get by stories) nom) + ?~ soy + (ta-evil (crip "no story {(trip nom)}")) + so-done:(~(so-usage so nom ~ u.soy) add tas) + :: :> # %messaging +| ++ action-convey @@ -531,7 +577,7 @@ :> :> store a started subscription as source. :: - |= {nom/naem src/source} + |= {nom/name src/source} %- (ta-know nom) |= sor/_so =< so-done (so-greet:sor src) :: @@ -540,7 +586,7 @@ :> :> removes {src} from story {nom}'s sources. :: - |= {nom/naem src/source} + |= {nom/name src/source} %- (ta-know nom) |= sor/_so =< so-done (so-leave:sor src) :: @@ -573,7 +619,7 @@ $(sos t.sos) ::TODO runtime error ::%+ roll ~(tap by sos.piz) - ::|= {{n/naem b/burden} _..ta-take} + ::|= {{n/name b/burden} _..ta-take} ::=+ (fall (~(get by stories) n) *story) ::so-done:(~(so-bear so n ~ -) b) :: @@ -634,10 +680,12 @@ :: |= {who/circle ses/(list serial) fal/(unit tang)} ^+ +> - ~? ?=(^ fal) u.fal - =- (ta-delta %done who ses -) - ?~ fal %accepted - ~>(%slog.[0 u.fal] %rejected) + ?~ fal + (ta-delta %done who ses %accepted) + =. +> (ta-delta %done who ses %rejected) + =- (ta-grieve - u.fal) + %+ weld "{(scow %ud (lent ses))} message(s) " + "rejected by {(scow %p hos.who)}/{(trip nom.who)}" :: ++ ta-resub :> subscription dropped @@ -645,7 +693,7 @@ :> when a subscription gets dropped by gall, we :> resubscribe. :: - |= {nom/naem src/source} + |= {nom/name src/source} ^+ +> %- (ta-know nom) |= sor/_so =< so-done (so-resub:sor src) @@ -702,7 +750,7 @@ :> :> add or update telegram {gam} in story {nom}. :: - |= {nom/naem gam/telegram} + |= {nom/name gam/telegram} %- (ta-know nom) |= sor/_so =< so-done (so-learn:sor [our.bol nom] gam) :: @@ -726,7 +774,7 @@ :> acs: hall actions issued due to changes. :: story is faceless to ease data access. :: - $: nom/naem + $: nom/name acs/(list action) story == @@ -848,7 +896,8 @@ $bear (so-bear bur.rum) $peer (so-delta-our rum) $gram (so-open src nev.rum) - $remove (so-delta-our %config src %remove ~) + $remove ::TODO should also remove from {remotes}? + (so-delta-our %config src %remove ~) :: $new ?: =(src so-cir) @@ -901,6 +950,8 @@ :: |= {gaz/(list telegram) cos/lobby pes/crowd} ^+ +> + ~? (gth (lent gaz) 2.000) + [%unexpected-scrollback-length nom (lent gaz)] =* self +> :: local config =. self @@ -996,12 +1047,19 @@ ^+ +> :: only have presence if you have write permission. ?. |((so-admire who) ?=($remove -.dif)) +> - :: ignore if it won't result in change. + :: ignore if it won't result in change, + :: or if it sets an impersonating handle. ?. ?: ?=($remove -.dif) (~(has by locals) who) ?| !(~(has by locals) who) :: - =+ (~(got by locals) who) - !=(- (change-status - dif)) + =+ old=(~(got by locals) who) + =+ new=(change-status - dif) + ?& !=(old new) + :: + ?= $~ + (rush (fall han.man.new '') ;~(pfix sig fed:ag)) + ::TODO calling with %+ gives syntax error + == == +> (so-delta-our %status so-cir who dif) @@ -1073,6 +1131,17 @@ ?: =(cap cap.shape) +> (so-delta-our %config so-cir %caption cap) :: + ++ so-usage + :> add or remove usage tags. + :: + |= {add/? tas/tags} + ^+ +> + =/ sas/tags + %. tag.shape + ?:(add ~(dif in tas) ~(int in tas)) + ?~ sas +>.$ + (so-delta-our %config so-cir %usage add sas) + :: ++ so-filter :> change message rules :> @@ -1127,6 +1196,15 @@ |= src/source ^+ +> =+ seq=(~(get by sequence) cir.src) + =/ ner/range + ?~ seq ran.src + =- `[[%ud u.seq] -] + ?~ ran.src ~ + tal.u.ran.src + :: if our subscription changes or ends, remove + :: the original source. + =? +>.$ !=(ner ran.src) + (so-delta-our %config so-cir %source | src) :: if we're past the range, don't resubscribe. ?: ?& ?=(^ ran.src) ?=(^ tal.u.ran.src) @@ -1138,13 +1216,8 @@ == == == - (so-delta-our %follow | [src ~ ~]) - =- (so-delta-our %follow & [[cir.src -] ~ ~]) - ^- range - ?~ seq ran.src - =- `[[%ud u.seq] -] - ?~ ran.src ~ - tal.u.ran.src + +>.$ + (so-delta-our %follow & [[cir.src -] ~ ~]) :: ++ so-first-grams :> beginning of stream @@ -1289,9 +1362,16 @@ |= {src/circle gam/telegram} ^+ +> :: check for write permissions. + ::TODO we want to !! instead of silently failing, + :: so that ++coup-repeat of the caller gets + :: an error. but the caller may not be the + :: author. if we check for that to be true, + :: can we guarantee it's not an older message + :: getting resent? does that matter? think. ?. (so-admire aut.gam) +> :: clean up the message to conform to our rules. =. sep.gam (so-sane sep.gam) + =. gam (filter-gram gam bol) :: if we already have it, ignore. =+ old=(~(get by known) uid.gam) ?. &(?=(^ old) =(gam (snag u.old grams))) @@ -1321,14 +1401,6 @@ =/ sus/(set ship) %. sis.con.shape ?:(add ~(dif in sis) ~(int in sis)) - =. +>.$ - :: if banishing: notify only those affected. - :: if inviting: notify all targets. - =? sis !inv sus - =- (so-act [%phrase - [%inv inv so-cir]~]) - %- ~(rep in `(set ship)`sis) - |= {s/ship a/audience} - (~(put in a) [s %inbox]) ?~ sus +>.$ :: if banished, remove their presences. =? +>.$ !inv @@ -1419,7 +1491,7 @@ ++ da-present :> send %present cmd :: - |= {hos/ship nos/(set naem) dif/diff-status} + |= {hos/ship nos/(set name) dif/diff-status} ^+ +> %- da-emit :* ost.bol @@ -1572,7 +1644,7 @@ :> in case of a new or deleted story, specialized :> arms are called. :: - |= {nom/naem det/delta-story} + |= {nom/name det/delta-story} ^+ +> ?+ -.det =< sa-done @@ -1590,7 +1662,7 @@ :> :> creates story {nom} with config {con}. :: - |= {nom/naem cof/config} + |= {nom/name cof/config} ^+ +> =< sa-done %- ~(sa-change sa nom *story) @@ -1601,7 +1673,7 @@ :> :> calls the story core to delete story {nom}. :: - |= nom/naem + |= nom/name ^+ +> =. +> %- da-emil @@ -1616,7 +1688,7 @@ |_ :> nom: story name in {stories}. :: story is faceless to ease data access. :: - $: nom/naem + $: nom/name story == :> # %resolve @@ -1891,7 +1963,7 @@ %^ circle-wire nom ~[%grams %config-l %group-l] [cir ran] - [0 %pull wir [hos.cir dap.bol] ~] + [ost.bol %pull wir [hos.cir dap.bol] ~] :: ++ sa-eject :> removes ships {sis} from {followers}. @@ -1940,7 +2012,7 @@ :> constructs a /circle %peer path for subscribing :> {nom} to a source. :: - |= {nom/naem wat/(list circle-data) source} + |= {nom/name wat/(list circle-data) source} ^- wire ;: weld /circle/[nom]/(scot %p hos.cir)/[nom.cir] @@ -1956,7 +2028,7 @@ |= wir/wire ^- move =+ tar=(wire-to-target wir) - [0 %peer wir [p.tar dap.bol] q.tar] + [ost.bol %peer wir [p.tar dap.bol] q.tar] :: ++ wire-to-target :> ship+path from wire @@ -2011,7 +2083,7 @@ :: |= $: wir/wire $= fun - $- {nom/naem src/source} + $- {nom/name src/source} {(list move) _.} == =+ wer=(etch wir) @@ -2049,14 +2121,14 @@ ?. =(who our.bol) [bon %quit ~]~ %- zing %+ turn ~(tap in ~(key by stories)) - |= n/naem + |= n/name ^- (list move) - :~ :^ 0 %poke / + :~ :^ ost.bol %poke / :+ [our.bol dap.bol] %hall-action :^ %source n | [[[our.bol nom.qer] ran.qer] ~ ~] :: - :^ 0 %pull + :^ ost.bol %pull %^ circle-wire n ~(tap in wat.qer) [[our.bol nom.qer] ran.qer] [[our.bol dap.bol] ~] @@ -2093,6 +2165,15 @@ ::[:(welp m mos (affection d)) +>.^$] :: ++ peek + |= pax/path + ?> ?=({$x *} pax) :: others unsupported. + ^- (unit (unit (pair mark prize))) + =+ piz=(look (path-to-query t.pax)) + ?~ piz ~ + ?~ u.piz [~ ~] + ``[%hall-prize u.u.piz] +:: +++ look :> query on state :> :> find the result (if any) for a given query. @@ -2105,10 +2186,10 @@ :: $circles =- ``[%circles -] - %- ~(gas in *(set naem)) + %- ~(gas in *(set name)) %+ murn ~(tap by stories) - |= {n/naem s/story} - ^- (unit naem) + |= {n/name s/story} + ^- (unit name) ?:((~(so-visible so:ta n ~ s) who.qer) `n ~) :: $public @@ -2117,14 +2198,16 @@ $burden :+ ~ ~ :- %burden - %- ~(gas in *(map naem burden)) + %- ~(gas in *(map name burden)) %+ murn ~(tap by stories) - |= {n/naem s/story} - ^- (unit (pair naem burden)) + |= {n/name s/story} + ^- (unit (pair name burden)) :: only auto-federate channels for now. ?. ?=($channel sec.con.shape.s) ~ :+ ~ n - :+ grams.s + :: share no more than the last 100, for performance reasons. + :+ ?: (lte count.s 100) grams.s + (slag (sub count.s 100) grams.s) [shape.s mirrors.s] [locals.s remotes.s] :: @@ -2170,7 +2253,7 @@ :> modify a %story diff to make it about their ship :> instead of ours. :: - |= {who/ship nom/naem det/delta-story} + |= {who/ship nom/name det/delta-story} ^- rumor-story ?+ -.det det :: @@ -2212,7 +2295,7 @@ :> for a given story. assumes both story and :> telegram are known. :: - |= {nom/naem gam/telegram} + |= {nom/name gam/telegram} ^- envelope :_ gam %. uid.gam @@ -2222,7 +2305,7 @@ :: |= $: wer/(unit circle) wat/(set circle-data) - nom/naem + nom/name det/delta-story == ^- ? @@ -2239,6 +2322,7 @@ ?+ -.det %hasnot $gram %grams $new %config-l + $remove %config-l $config ?: =(cir.det [our.bol nom]) %config-l %config-r $status ?: =(cir.det [our.bol nom]) @@ -2272,17 +2356,27 @@ ::REVIEW this could be considered leaky, since it :: doesn't check if {who} ever knew of {nom}, :: but does that matter? can't really check.. + :: if the story got deleted, remove it from the circles listing. ?: ?=($remove -.det.det) `| - =+ soy=(~(got by stories) who.qer) - ?. ?| ?=($new -.det.det) - ?& ?=($config -.det.det) - ?=($permit -.dif.det.det) - ?=(?($channel $village) sec.con.shape.soy) - (~(has in sis.dif.det.det) who.qer) - == + =+ soy=(~(got by stories) nom.det) + :: if the story got created, or something about the read permissions set + :: for the subscriber changed, update the circles listing. + =; dif/? + ?. dif ~ + :: if the story just got created, don't send a remove rumor, because it + :: never showed up in the first place. + =- ?:(&(?=($new -.det.det) !-) ~ `-) + ?| (team:title our.bol who.qer) + (~(so-visible so:ta nom.det ~ soy) who.qer) + == + ?| ?=($new -.det.det) + :: + ?& ?=($config -.det.det) + ?=($permit -.dif.det.det) + ?=(?($channel $village) sec.con.shape.soy) + (~(has in sis.dif.det.det) who.qer) == - ~ - `(~(so-visible so:ta nom.det ~ soy) who.qer) + == :: $public ?. ?=($public -.det) ~ @@ -2321,10 +2415,15 @@ ?. =(nom.qer nom.det) ~ ?. %- circle-feel-story [wer.qer wat.qer nom.det det.det] ~ - =/ sor (~(got by stories) nom.qer) - ?. =< in %. ran.qer - ~(so-in-range so:ta nom.qer ~ sor) ~ - ?. ?=(?($gram $new $config $status) -.det.det) ~ + ?. ?| ?=($remove -.det.det) + :: + =< in %. ran.qer + =+ soy=(~(got by stories) nom.qer) + ~(so-in-range so:ta nom.qer ~ soy) + == + ~ + =+ out=?($gram $new $config $status $remove) + ?. ?=(out -.det.det) ~ :+ ~ %circle ?+ det.det det.det {$gram *} @@ -2559,7 +2658,7 @@ %- pre-bake ta-done:(ta-subscribe:ta src.bol qer) :_ +>.$ - =+ piz=(peek qer) + =+ piz=(look qer) ?~ piz ~&([%query-unavailable pax] mos) ?~ u.piz ~&([%query-invalid pax] mos) :_ mos @@ -2578,11 +2677,10 @@ |= pax/path ^- (quip move _+>) %- pre-bake - :_ ~ =+ qer=(path-to-query %circle pax) ?> ?=($circle -.qer) - :+ %story nom.qer - [%peer | src.bol qer] + ?. (~(has by stories) nom.qer) ~ + [%story nom.qer %peer | src.bol qer]~ :: ++ reap :> subscription n/ack @@ -2591,19 +2689,23 @@ :: |= {wir/wire fal/(unit tang)} ^- (quip move _+>) - ?. ?=($circle -.wir) - ?~ fal [~ +>] - ~| reap-fail+wir - (mean u.fal) - %+ etch-circle wir - |= {nom/naem src/source} - ?~ fal - %- pre-bake - ta-done:(ta-greet:ta nom src) - =. u.fal [>%failed-subscribe nom src< u.fal] - %- (slog (flop u.fal)) %- pre-bake - ta-done:(ta-leave:ta nom src) + %+ welp + ?. ?=({$circle *} wir) ~ + =+ wer=(etch wir) + ?> ?=($circle -.wer) + =< ta-done + %. [nom.wer src.wer] + ?~ fal ta-greet:ta + ta-leave:ta + ?~ fal ~ + =< ta-done + =- (ta-grieve:ta - u.fal) + =+ (wire-to-target wir) + %+ weld "failed (re)subscribe to {(scow %p p)} on " + %+ roll q + |= {a/@ta b/tape} + :(weld b "/" (trip a)) :: ++ quit :> dropped subscription @@ -2612,9 +2714,7 @@ :: |= wir/wire ^- (quip move _+>) - :_ +> - ?. =(src.bol our.bol) ~ - [(wire-to-peer wir) ~] + [[(wire-to-peer wir) ~] +>] :: ++ quit-circle :> dropped circle sub @@ -2624,11 +2724,8 @@ |= wir/wire ^- (quip move _+>) %+ etch-circle [%circle wir] - |= {nom/naem src/source} + |= {nom/name src/source} %- pre-bake - :: when we got kicked, don't resub, remove source. - ?. =(src.bol our.bol) - ta-done:(ta-action:ta %source nom | [src ~ ~]) ta-done:(ta-resub:ta nom src) :: ++ coup-repeat @@ -2656,7 +2753,7 @@ :> to be re-loaded by ++poke-hall-load. ::TODO maybe update to also store sourced list. :: - |= nom/naem + |= nom/name ^- (quip move _+>) =/ paf/path /(scot %p our.bol)/home/(scot %da now.bol)/hall/[nom]/hall-telegrams @@ -2673,7 +2770,7 @@ ++ poke-load-legacy :> loads legacy messages into the story {nom}. :: - |= nom/naem + |= nom/name ^- (quip move _+>) =/ jams/json .^ json @@ -2693,7 +2790,7 @@ :> loads the telegrams of story {nom} into our state, :> as saved in ++poke-hall-save. :: - |= nom/naem + |= nom/name ^- (quip move _+>) =/ grams .^ (list telegram) @@ -2708,7 +2805,7 @@ ++ poke-hall-log :> starts logging story {nom}'s messages. :: - |= nom/naem + |= nom/name ^- (quip move _+>) :- [(log-to-file nom) ~] %= +>.$ @@ -2720,7 +2817,7 @@ ++ poke-hall-unlog :> stops logging story {nom}'s messages. :: - |= nom/naem + |= nom/name ^- (quip move _+>) :- ~ +>.$(log (~(del by log) nom)) @@ -2735,11 +2832,11 @@ :_ %_ . log %- ~(urn by log) - |= {nom/naem len/@ud} + |= {nom/name len/@ud} count:(~(got by stories) nom) == %+ murn ~(tap by log) - |= {nom/naem len/@ud} + |= {nom/name len/@ud} ^- (unit move) ?: (gte len count:(~(got by stories) nom)) ~ @@ -2748,7 +2845,7 @@ ++ log-to-file :> logs all grams of story {nom} to a file. :: - |= nom/naem + |= nom/name ^- move =+ ^- paf/path =+ day=(year %*(. (yore now.bol) +.t +:*tarp)) @@ -2763,13 +2860,15 @@ == :: ::TODO for debug purposes. remove eventually. +:: users beware, here be dragons. ++ poke-noun |= a/@t ^- (quip move _+>) - ?: =(a 'debug') + ?: =(a 'check') + ~& 'verifying message reference integrity...' =- ~&(- [~ +>.$]) %- ~(urn by stories) - |= {n/naem s/story} + |= {n/name s/story} =+ %- ~(rep by known.s) |= {{u/serial a/@ud} k/@ud m/@ud} :- ?:((gth a k) a k) @@ -2785,10 +2884,20 @@ lent=(lent grams.s) known=k mismatch=m + ?: =(a 'check subs') + ~& 'here are all incoming non-circle subs' + ~& ^- (list (pair ship path)) + %+ murn ~(tap by sup.bol) + |= {b/bone s/ship p/path} + ^- (unit (pair ship path)) + ?: ?=({$circle *} p) ~ + `[s p] + [~ +>] ?: =(a 'rebuild') + ~& 'rebuilding message references...' =- [~ +>.$(stories -)] %- ~(urn by stories) - |= {nom/naem soy/story} + |= {nom/name soy/story} =+ %+ roll grams.soy |= {t/telegram c/@ud k/(map serial @ud) s/(map circle (list @ud))} :+ +(c) (~(put by k) uid.t c) @@ -2799,5 +2908,30 @@ %+ ~(put by s) src [c (fall (~(get by s) src) ~)] soy(count c, known k, sourced s) + ?: =(a 'refederate') + ~& 'refederating. may take a while...' + :_ +> + =+ bov=(above our.bol) + ?: =(bov our.bol) ~ + :~ [ost.bol %pull /burden [bov dap.bol] ~] + (wire-to-peer /burden) + == + ?: =(a 'incoming') + ~& 'incoming subscriptions (ignoring circle subs):' + ~& %+ skip ~(tap by sup.bol) + |= {bone (pair ship path)} + &(?=({$circle *} q) !?=({$circle $inbox *} q)) + [~ +>] + ?: =(a 'sources') + ~& 'sources per story:' + ~& %- ~(urn by stories) + |= {n/name s/story} + [n src.shape.s] + [~ +>] + ?: =(`0 (find "re-listen " (trip a))) + ~& 're-listening' + :_ +> + :_ ~ + (wire-to-peer /report/(crip (slag 10 (trip a)))) [~ +>] -- diff --git a/app/hood.hoon b/app/hood.hoon index 0dfdbd226..506c808f1 100644 --- a/app/hood.hoon +++ b/app/hood.hoon @@ -133,6 +133,7 @@ ++ coup-kiln-spam (wrap take-coup-spam):from-kiln ++ diff-sole-effect-drum-phat (wrap diff-sole-effect-phat):from-drum ++ init-helm |=({way/wire *} [~ +>]) +++ mack-kiln (wrap mack):from-kiln ++ made-write (wrap made):from-write ++ made-kiln (wrap take-made):from-kiln ++ mere-kiln (wrap take-mere):from-kiln @@ -164,6 +165,9 @@ ++ poke-helm-nuke (wrap poke-nuke):from-helm ++ poke-helm-begin (wrap poke-begin):from-helm ++ poke-helm-spawn (wrap poke-spawn):from-helm +++ poke-helm-tlon-add-fora (wrap poke-tlon-add-fora):from-helm +++ 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 @@ -183,6 +187,7 @@ ++ poke-kiln-overload (wrap poke-overload):from-kiln ++ poke-kiln-unmount (wrap poke-unmount):from-kiln ++ poke-kiln-unsync (wrap poke-unsync):from-kiln +++ poke-kiln-permission (wrap poke-permission):from-kiln ++ poke-womb-invite (wrap poke-invite):from-womb ++ poke-womb-save (wrap poke-save):from-womb ++ poke-womb-obey (wrap poke-obey):from-womb diff --git a/app/talk.hoon b/app/talk.hoon index 5983323da..d6553ce88 100644 --- a/app/talk.hoon +++ b/app/talk.hoon @@ -7,168 +7,185 @@ ::TODO [type query] => [press tab to cycle search results, newest-first] :: => [escape to clear] :: -::> This client implementation makes use of the %inbox -::> for all its subscriptions and messaging. All -::> rumors received are exclusively about the %inbox, -::> since that's the only thing the client ever -::> subscribes to. +:: This client implementation makes use of the %inbox +:: for all its subscriptions and messaging. All +:: rumors received are exclusively about the %inbox, +:: since that's the only thing the client ever +:: subscribes to. :: -/- hall, sole ::< structures -/+ hall, sole ::< libraries +/- hall, sole :: structures +/+ hall, sole :: libraries /= seed /~ !>(.) :: :::: :: =, hall =, sole -=> ::> || - ::> || %arch - ::> || - ::> data structures +=> :> # + :> # %arch + :> # + :> data structures :: |% - ++ state ::> application state + ++ state :> application state $: :: messaging state :: - count/@ud ::< (lent grams) - grams/(list telegram) ::< all history - known/(map serial @ud) ::< messages heard - sources/(set circle) ::< our subscriptions + grams/(list telegram) :< all history + known/(map serial @ud) :< messages heard + last/@ud :< last heard + count/@ud :< (lent grams) + sources/(set circle) :< our subscriptions :: circle details :: - remotes/(map circle group) ::< remote presences - mirrors/(map circle config) ::< remote configs + remotes/(map circle group) :< remote presences + mirrors/(map circle config) :< remote configs :: ui state :: - nicks/(map ship nick) ::< human identities - bound/(map audience char) ::< bound circle glyphs - binds/(jug char audience) ::< circle glyph lookup - cli/shell ::< interaction state + nicks/(map ship nick) :< human identities + bound/(map audience char) :< bound circle glyphs + binds/(jug char audience) :< circle glyph lookup + cli/shell :< interaction state == :: - ++ shell ::> console session - $: id/bone ::< identifier - latest/@ud ::< latest shown msg num - say/sole-share ::< console state - active/audience ::< active targets - settings/(set term) ::< frontend settings - width/@ud ::< display width - timez/(pair ? @ud) ::< timezone adjustment + ++ shell :> console session + $: id/bone :< identifier + latest/@ud :< latest shown msg num + say/sole-share :< console state + active/audience :< active targets + settings/(set term) :< frontend settings + width/@ud :< display width + timez/(pair ? @ud) :< timezone adjustment == :: - ++ move (pair bone card) ::< all actions - ++ lime ::> diff fruit + ++ move (pair bone card) :< all actions + ++ lime :> diff fruit $% {$sole-effect sole-effect} :: == :: - ++ pear ::> poke fruit + ++ pear :> poke fruit $% {$hall-command command} :: {$hall-action action} :: == :: - ++ card ::> general card + ++ card :> general card $% {$diff lime} :: {$poke wire dock pear} :: {$peer wire dock path} :: + {$pull wire dock $~} :: == :: - ++ work ::> interface action + ++ work :> interface action $% :: circle management :: - {$join (map circle range)} ::< subscribe to - {$leave audience} ::< unsubscribe from - {$create security naem cord} ::< create circle - {$delete naem (unit cord)} ::< delete circle - {$depict naem cord} ::< change description - {$filter naem ? ?} ::< change message rules - {$invite naem (set ship)} ::< give permission - {$banish naem (set ship)} ::< deny permission - {$source naem (map circle range)} ::< add source - {$unsource naem (map circle range)} ::< remove source + {$join (map circle range)} :< subscribe to + {$leave audience} :< unsubscribe from + {$create security name cord} :< create circle + {$delete name (unit cord)} :< delete circle + {$depict name cord} :< change description + {$filter name ? ?} :< change message rules + {$invite name (set ship)} :< give permission + {$banish name (set ship)} :< deny permission + {$source name (map circle range)} :< add source + {$unsource name (map circle range)} :< remove source :: personal metadata :: - {$attend audience (unit presence)} ::< set our presence - {$name audience human} ::< set our name + {$attend audience (unit presence)} :< set our presence + {$name audience human} :< set our name :: messaging :: - {$say (list speech)} ::< send message - {$eval cord hoon} ::< send #-message - {$target p/audience q/(unit work)} ::< set active targets - {$reply $@(@ud {@u @ud}) (list speech)} ::< reply to + {$say (list speech)} :< send message + {$eval cord hoon} :< send #-message + {$target p/audience q/(unit work)} :< set active targets + {$reply $@(@ud {@u @ud}) (list speech)} :< reply to :: displaying info :: - {$number $@(@ud {@u @ud})} ::< relative/absolute - {$who audience} ::< presence - {$what (unit $@(char audience))} ::< show bound glyph + {$number $@(@ud {@u @ud})} :< relative/absolute + {$who audience} :< presence + {$what (unit $@(char audience))} :< show bound glyph + {$circles $~} :< show our circles + {$sources circle} :< show active sources :: ui settings :: - {$bind char (unit audience)} ::< bind glyph - {$unbind char (unit audience)} ::< unbind glyph - {$nick (unit ship) (unit cord)} ::< un/set/show nick - {$set term} ::< enable setting - {$unset term} ::< disable setting - {$width @ud} ::< change display width - {$timez ? @ud} ::< adjust shown times + {$bind char (unit audience)} :< bind glyph + {$unbind char (unit audience)} :< unbind glyph + {$nick (unit ship) (unit cord)} :< un/set/show nick + {$set term} :< enable setting + {$unset term} :< disable setting + {$width @ud} :< change display width + {$timez ? @ud} :< adjust shown times :: miscellaneous :: - {$show circle} ::< show membership - {$hide circle} ::< hide membership - {$help $~} ::< print usage info + {$show circle} :< show membership + {$hide circle} :< hide membership + {$help $~} :< print usage info == :: - ++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] ::< circle char pool ' + ++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] :< circle char pool ' -- :: -::> || -::> || %work -::> || -::> functional cores and arms. +:> # +:> # %work +:> # +:> functional cores and arms. :: -|_ {bol/bowl:gall state} +|_ {bol/bowl:gall $0 state} :: -++ prep ::< prepare state - ::> adapts state. +:> # %transition +:> prep transition ++| +:: +++ prep + :> adapts state :: - |= old/(unit state) + => |% + ++ states + $%({$0 s/state}) + -- + =| mos/(list move) + |= old/(unit states) ^- (quip move _..prep) ?~ old ta-done:ta-init:ta - =* o u.old - =. count.o (lent grams.o) - =+ %+ reel grams.o - |= {t/telegram c/@ud k/(map serial @ud)} - [+(c) (~(put by k) uid.t c)] - =. known.o k - [~ ..prep(+<+ u.old)] + ?- -.u.old + $0 + [mos ..prep(+<+ u.old)] + == :: -::> || -::> || %utility -::> || -::> small utility functions. -::+| +:> # +:> # %utility +:> # +:> small utility functions. ++| :: -++ our +++ self (true-self our.bol) :: -++ server ::< our hall instance +++ server + :> our hall instance ^- dock - [our %hall] + [self %hall] :: -++ inbox ::< client's circle name - ::> produces the name of the circle used by this - ::> client for all its operations - ^- naem +++ inbox + :> client's circle name + :> + :> produces the name of the circle used by this + :> client for all its operations + ^- name %inbox :: -++ incir ::< client's circle - ::> ++inbox, except a full circle. +++ incir + :> client's circle + :> + :> ++inbox, except a full circle. ^- circle - [our inbox] + [self inbox] :: -++ renum ::< gram i# by serial - ::> find the grams list index for gram with serial. +++ renum + :> find the grams list index for gram with serial. |= ser/serial ^- (unit @ud) =+ num=(~(get by known) ser) ?~ num ~ `(sub count +(u.num)) :: -++ recall ::< gram by serial - ::> find a known gram with serial {ser}. +++ recall + :> find a known gram with serial {ser}. |= ser/serial ^- (unit telegram) =+ num=(renum ser) ?~ num ~ `(snag u.num grams) :: -++ bound-from-binds ::< bound from binds - ::> using a mapping of character to audiences, create - ::> a mapping of audience to character. +++ bound-from-binds + :> bound from binds + :> + :> using a mapping of character to audiences, create + :> a mapping of audience to character. :: |= bin/_binds ^+ bound @@ -178,8 +195,8 @@ |= {a/char b/(set audience)} (turn ~(tap by b) |=(c/audience [c a])) :: -++ glyph ::< grab a glyph - ::> finds a new glyph for assignment. +++ glyph + :> finds a new glyph for assignment. :: |= idx/@ =< cha @@ -192,7 +209,8 @@ ole [new num] :: -++ peer-client ::< ui state peer move +++ peer-client + :> ui state peer move ^- move :* ost.bol %peer @@ -207,32 +225,44 @@ %peer /server/inbox server - /circle/[inbox]/grams/config/group/(scot %ud count) + :: + %+ welp /circle/[inbox]/grams/config/group + ?. =(0 count) + [(scot %ud last) ~] + =+ history-days=~d5 + [(scot %da (sub now.bol history-days)) ~] == :: -::> || -::> || %engines -::> || -::> main cores. -::+| +:> # +:> # %engines +:> # +:> main cores. ++| :: -++ ta :: per transaction - ::> for every transaction/event (poke, peer etc.) - ::> talk receives, the ++ta transaction core is - ::> called. - ::> in processing transactions, ++ta may modify app - ::> state, or create moves. these moves get produced - ::> upon finalizing the core's with with ++ta-done. - ::> when making changes to the shell, the ++sh core is - ::> used. +++ ta + :> per transaction + :> + :> for every transaction/event (poke, peer etc.) + :> talk receives, the ++ta transaction core is + :> called. + :> in processing transactions, ++ta may modify app + :> state, or create moves. these moves get produced + :> upon finalizing the core's with with ++ta-done. + :> when making changes to the shell, the ++sh core is + :> used. :: - |_ ::> moves: moves created by core operations. + |_ :> moves: moves created by core operations. :: moves/(list move) :: - ++ ta-done ::< resolve core - ::> produces the moves stored in ++ta's moves. - ::> %sole-effect moves get squashed into a %mor. + :> # %resolve + +| + :: + ++ ta-done + :> resolve core + :> + :> produces the moves stored in ++ta's moves. + :> %sole-effect moves get squashed into a %mor. :: ^+ [*(list move) +>] :_ +> @@ -250,47 +280,49 @@ =+ moz=(flop p.yop) =/ foc/(unit sole-effect) ?~ q.yop ~ - ?~ t.q.yop `i.q.yop ::< single sole-effect - `[%mor (flop q.yop)] ::< more sole-effects + ?~ t.q.yop `i.q.yop :: single sole-effect + `[%mor (flop q.yop)] :: more sole-effects :: produce moves or sole-effects and moves. ?~ foc moz ?~ id.cli ~&(%client-no-sole moz) [[id.cli %diff %sole-effect u.foc] moz] :: - ::> || - ::> || %emitters - ::> || - ::> arms that create outward changes. - ::+| + :> # + :> # %emitters + :> # + :> arms that create outward changes. + +| :: - ++ ta-emil ::< emit move list - ::> adds multiple moves to the core's list. - ::> flops to emulate ++ta-emit. + ++ ta-emil + :> emit move list + :> + :> adds multiple moves to the core's list. + :> flops to emulate ++ta-emit. :: |= mol/(list move) %_(+> moves (welp (flop mol) moves)) :: - ++ ta-emit ::< emit a move - ::> adds a move to the core's list. + ++ ta-emit + :> adds a move to the core's list. :: |= mov/move %_(+> moves [mov moves]) :: - ::> || - ::> || %interaction-events - ::> || - ::> arms that apply events we received. - ::+| + :> # + :> # %interaction-events + :> # + :> arms that apply events we received. + +| :: - ++ ta-init ::< initialize app - ::> subscribes to our hall. + ++ ta-init + :> subscribes to our hall. :: %- ta-emil ^- (list move) ~[peer-client peer-inbox] :: - ++ ta-take ::< accept prize - ::> + ++ ta-take + :> accept prize :: |= piz/prize ^+ +> @@ -311,8 +343,8 @@ == == :: - ++ ta-hear ::< apply change - ::> + ++ ta-hear + :> apply change :: |= rum/rumor ^+ +> @@ -330,8 +362,8 @@ (ta-change-circle rum.rum) == :: - ++ ta-change-circle ::< apply circle change - ::> + ++ ta-change-circle + :> apply circle change :: |= rum/rumor-story ^+ +> @@ -339,7 +371,7 @@ ~&([%unexpected-circle-rumor -.rum] +>) :: $gram - (ta-learn gam.nev.rum) + (ta-open nev.rum) :: $config =+ cur=(fall (~(get by mirrors) cir.rum) *config) @@ -351,22 +383,25 @@ ?& ?=($source -.dif.rum) add.dif.rum =(cir.rum incir) - ?=($~ ran.src.dif.rum) == =* cir cir.src.dif.rum =+ ren=~(cr-phat cr cir) =+ gyf=(~(get by bound) [cir ~ ~]) =< sh-done - => :_ . - %- ~(sh-act sh cli) - [%notify [cir ~ ~] `%hear] + =/ sho + :: only present if we're here indefinitely. + =* ran ran.src.dif.rum + ?. |(?=($~ ran) ?=($~ tal.u.ran)) + ~(. sh cli) + %- ~(sh-act sh cli) + [%notify [cir ~ ~] `%hear] ?^ gyf - (sh-note "has glyph {[u.gyf ~]} for {ren}") + (sh-note:sho "has glyph {[u.gyf ~]} for {ren}") :: we use the rendered circle name to determine :: the glyph for higher glyph consistency when :: federating. =+ cha=(glyph (mug ren)) - (sh-work %bind cha `[cir ~ ~]) + (sh-work:sho %bind cha `[cir ~ ~]) %= +>.$ sources ?. &(?=($source -.dif.rum) =(cir.rum incir)) @@ -398,8 +433,8 @@ == == :: - ++ ta-change-glyph ::< apply changed glyphs - ::> applies new set of glyph bindings. + ++ ta-change-glyph + :> applies new set of glyph bindings. :: |= {bin/? gyf/char aud/audience} ^+ +> @@ -409,40 +444,45 @@ =. bound (bound-from-binds nek) sh-done:~(sh-prod sh cli) :: - ::> || - ::> || %messages - ::> || - ::> storing and updating messages. - ::+| + :> # + :> # %messages + :> # + :> storing and updating messages. + +| :: - ++ ta-unpack ::< open envelopes - ::> the client currently doesn't care about nums. + ++ ta-unpack + :> open envelopes + :> + :> the client currently doesn't care about nums. :: |= nes/(list envelope) ^+ +> - (ta-lesson (turn nes tail)) + ?~ nes +> + $(nes t.nes, +> (ta-open i.nes)) :: - ++ ta-lesson ::< learn messages - ::> learn all telegrams in a list. + ++ ta-open + :> learn message from an envelope. :: - |= gaz/(list telegram) + |= nev/envelope ^+ +> - ?~ gaz +> - $(gaz t.gaz, +> (ta-learn i.gaz)) + =? last (gth num.nev last) num.nev + (ta-learn gam.nev) :: - ++ ta-learn ::< save/update message - ::> store an incoming telegram, updating if it - ::> already exists. + ++ ta-learn + :> save/update message + :> + :> store an incoming telegram, updating if it + :> already exists. :: |= gam/telegram ^+ +> =+ old=(renum uid.gam) ?~ old - (ta-append gam) ::< add - (ta-revise u.old gam) ::< modify + (ta-append gam) :: add + (ta-revise u.old gam) :: modify :: - ++ ta-append ::< append message - ::> store a new telegram. + ++ ta-append + :> store a new telegram. :: |= gam/telegram ^+ +> @@ -453,33 +493,36 @@ =< sh-done (~(sh-gram sh cli) gam) :: - ++ ta-revise ::< revise message - ::> modify a telegram we know. + ++ ta-revise + :> modify a telegram we know. :: |= {num/@ud gam/telegram} =+ old=(snag num grams) ?: =(gam old) +>.$ :: no change - =. grams (oust [num 1] grams) + =. grams + %+ welp + (scag num grams) + [gam (slag +(num) grams)] ?: =(sep.gam sep.old) +>.$ :: no worthy change =< sh-done (~(sh-gram sh cli) gam) :: - ::> || - ::> || %console - ::> || - ::> arms for shell functionality. - ::+| + :> # + :> # %console + :> # + :> arms for shell functionality. + +| :: - ++ ta-console ::< initialize shell - ::> initialize the shell of this client. + ++ ta-console + :> initialize the shell of this client. :: ^+ . =/ she/shell %*(. *shell id ost.bol, active (sy incir ~), width 80) sh-done:~(sh-prod sh she) :: - ++ ta-sole ::< apply sole input - ::> applies sole-action. + ++ ta-sole + :> apply sole input :: |= act/sole-action ^+ +> @@ -487,38 +530,42 @@ ~&(%strange-sole !!) sh-done:(~(sh-sole sh cli) act) :: - ++ sh ::< per console - ::> shell core, responsible for handling user input - ::> and the related actions, and outputting changes - ::> to the cli. + ++ sh + :> per console + :> + :> shell core, responsible for handling user input + :> and the related actions, and outputting changes + :> to the cli. :: - |_ $: ::> she: console state. - ::> man: our mailbox + |_ $: :> she: console state. :: she/shell == :: - ++ sh-done ::< resolve core - ::> stores changes to the cli. + :> # %resolve + +| + :: + ++ sh-done + :> stores changes to the cli. :: ^+ +> +>(cli she) :: - ::> || - ::> || %emitters - ::> || - ::> arms that create outward changes. - ::+| + :> # + :> # %emitters + :> # + :> arms that create outward changes. + +| :: - ++ sh-fact ::< send console effect - ::> adds a console effect to ++ta's moves. + ++ sh-fact + :> adds a console effect to ++ta's moves. :: |= fec/sole-effect ^+ +> +>(moves [[id.she %diff %sole-effect fec] moves]) :: - ++ sh-act ::< send action - ::> adds an action to ++ta's moves. + ++ sh-act + :> adds an action to ++ta's moves. :: |= act/action ^+ +> @@ -533,14 +580,14 @@ == == :: - ::> || - ::> || %cli-interaction - ::> || - ::> processing user input as it happens. - ::+| + :> # + :> # %cli-interaction + :> # + :> processing user input as it happens. + +| :: - ++ sh-sole ::< apply edit - ::> applies sole action. + ++ sh-sole + :> applies sole action. :: |= act/sole-action ^+ +> @@ -550,9 +597,11 @@ $ret sh-obey == :: - ++ sh-edit ::< apply sole edit - ::> called when typing into the cli prompt. - ::> applies the change and does sanitizing. + ++ sh-edit + :> apply sole edit + :> + :> called when typing into the cli prompt. + :> applies the change and does sanitizing. :: |= cal/sole-change ^+ +> @@ -568,40 +617,44 @@ +>.$ (sh-slug fix) :: - ++ sh-read ::< command parser - ::> parses the command line buffer. produces work - ::> items which can be executed by ++sh-work. + ++ sh-read + :> command parser + :> + :> parses the command line buffer. produces work + :> items which can be executed by ++sh-work. :: =< work - ::> || %parsers - ::> various parsers for command line input. + :> # %parsers + :> various parsers for command line input. |% - ++ expr ::< [cord hoon] + ++ expr + :> [cord hoon] |= tub/nail %. tub %+ stag (crip q.tub) wide:(vang & [&1:% &2:% (scot %da now.bol) |3:%]) :: - ++ dare ::< @dr + ++ dare + :> @dr %+ sear |= a/coin ?. ?=({$$ $dr @} a) ~ (some `@dr`+>.a) nuck:so :: - ++ ship ;~(pfix sig fed:ag) ::< ship - ++ shiz ::< ship set + ++ ship ;~(pfix sig fed:ag) :< ship + ++ shiz :< ship set %+ cook |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) (most ;~(plug com (star ace)) ship) :: - ++ cire ::< local circle - ;~(pfix cen sym) + ++ cire :< local circle + ;~(pfix cen urs:ab) :: - ++ circ ::< circle + ++ circ :< circle ;~ pose (cold incir col) - ;~(pfix cen (stag our sym)) - ;~(pfix fas (stag (sein:title our) sym)) + ;~(pfix cen (stag self urs:ab)) + ;~(pfix fas (stag (sein:title self) urs:ab)) :: %+ cook |= {a/@p b/(unit term)} @@ -612,7 +665,7 @@ == == :: - ++ circles-flat ::< collapse mixed list + ++ circles-flat :< collapse mixed list |= a/(list (each circle (set circle))) ^- (set circle) ?~ a ~ @@ -621,13 +674,15 @@ $| (~(uni in $(a t.a)) p.i.a) == :: - ++ cirs ::< non-empty circles + ++ cirs :< non-empty circles %+ cook circles-flat %+ most ;~(plug com (star ace)) (^pick circ (sear sh-glyf glyph)) :: - ++ drat ::< @da or @dr - ::> pas: whether @dr's are in the past or not. + ++ drat + :> @da or @dr + :> + :> pas: whether @dr's are in the past or not. |= pas/? =- ;~(pfix sig (sear - crub:so)) |= a/^dime @@ -639,8 +694,8 @@ ?:(pas sub add) == :: - ++ pont ::< point for range - ::> hed: whether this is the head or tail point. + ++ pont :< point for range + :> hed: whether this is the head or tail point. |= hed/? ;~ pose (cold [%da now.bol] (jest 'now')) @@ -648,7 +703,7 @@ (stag %ud dem:ag) == :: - ++ rang ::< subscription range + ++ rang :< subscription range =+ ;~ pose (cook some ;~(pfix fas (pont |))) (easy ~) @@ -658,14 +713,14 @@ (easy ~) == :: - ++ sorz ::< non-empty sources + ++ sorz :< non-empty sources %+ cook ~(gas by *(map circle range)) (most ;~(plug com (star ace)) ;~(plug circ rang)) :: - ++ pick ::< message reference + ++ pick :< message reference ;~(pose nump (cook lent (star sem))) :: - ++ nump ::< number reference + ++ nump :< number reference ;~ pose ;~(pfix hep dem:ag) ;~ plug @@ -675,22 +730,22 @@ (stag 0 dem:ag) == :: - ++ pore ::< security + ++ pore :< security (perk %channel %village %journal %mailbox ~) :: - ++ lobe ::< y/n loob + ++ lobe :< y/n loob ;~ pose (cold %& ;~(pose (jest 'y') (jest '&') (just 'true'))) (cold %| ;~(pose (jest 'n') (jest '|') (just 'false'))) == :: - ++ message ::< exp, lin or url msg + ++ message :< exp, lin or url msg ;~ pose ;~(plug (cold %eval hax) expr) (stag %say speeches) == :: - ++ speeches ::< lin or url msgs + ++ speeches :< lin or url msgs %+ most (jest '•') ;~ pose (stag %url aurf:de-purl:html) @@ -698,20 +753,20 @@ :(stag %lin | ;~(less sem hax text)) == :: - ++ text ::< msg without break + ++ text :< msg without break %+ cook crip (plus ;~(less (jest '•') next)) :: - ++ nick (cook crip (plus next)) ::< nickname - ++ glyph (mask "/\\\{( parses cli prompt input using ++sh-read and - ::> sanitizes when invalid. + ++ sh-sane + :> sanitize input + :> + :> parses cli prompt input using ++sh-read and + :> sanitizes when invalid. :: |= {inv/sole-edit buf/(list @c)} ^- {lit/(list sole-edit) err/(unit @u)} @@ -877,8 +938,8 @@ ?~(q.wok ~ $(wok u.q.wok)) == :: - ++ sh-slug ::< edit to sanity - ::> corrects invalid prompt input. + ++ sh-slug + :> corrects invalid prompt input. :: |= {lit/(list sole-edit) err/(unit @u)} ^+ +> @@ -887,12 +948,14 @@ (~(transmit sole say.she) `sole-edit`?~(t.lit i.lit [%mor lit])) (sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)]) :: - ++ sh-obey ::< apply result - ::> called upon hitting return in the prompt. if - ::> input is invalid, ++sh-slug is called. - ::> otherwise, the appropriate work is done and - ::> the entered command (if any) gets displayed - ::> to the user. + ++ sh-obey + :> apply result + :> + :> called upon hitting return in the prompt. if + :> input is invalid, ++sh-slug is called. + :> otherwise, the appropriate work is done and + :> the entered command (if any) gets displayed + :> to the user. :: =+ fix=(sh-sane [%nop ~] buf.say.she) ?^ lit.fix @@ -902,39 +965,39 @@ %. u.jub =< sh-work =+ buf=buf.say.she + =? ..sh-obey &(?=({$';' *} buf) !?=($reply -.u.jub)) + (sh-note (tufa `(list @)`buf)) =^ cal say.she (~(transmit sole say.she) [%set ~]) - %- sh-fact - :* %mor - [%nex ~] + %+ sh-fact %mor + :~ [%nex ~] [%det cal] - ?. ?=({$';' *} buf) ~ - ?: ?=($reply -.u.jub) ~ - :_ ~ - [%txt (runt [14 '-'] `tape`['|' ' ' (tufa `(list @)`buf)])] == :: - ::> || - ::> || %user-action - ::> || - ::> processing user actions. - ::+| + :> # + :> # %user-action + :> # + :> processing user actions. + +| :: - ++ sh-work ::< do work - ::> implements worker arms for different talk - ::> commands. - ::> worker arms must produce updated state. + ++ sh-work + :> do work + :> + :> implements worker arms for different talk + :> commands. + :> worker arms must produce updated state. :: |= job/work ^+ +> =< work |% :: - ::> || - ::> || %helpers - ::> || - ::+| + :> # + :> # %helpers + :> # + +| :: - ++ work ::< call correct worker + ++ work + :> call correct worker ?- -.job :: circle management $join (join +.job) @@ -949,7 +1012,7 @@ $unsource (source | +.job) :: personal metadata $attend (attend +.job) - $name (name +.job) + $name (set-name +.job) :: messaging $say (say +.job) $eval (eval +.job) @@ -959,6 +1022,8 @@ $number (number +.job) $who (who +.job) $what (what +.job) + $circles circles + $sources (list-sources +.job) :: ui settings $bind (bind +.job) $unbind (unbind +.job) @@ -973,8 +1038,8 @@ $help help == :: - ++ activate ::< from %number - ::> prints message details. + ++ activate + :> prints message details. :: |= gam/telegram ^+ ..sh-work @@ -982,8 +1047,8 @@ =. ..sh-work (sh-fact tr-fact:tay) sh-prod(active.she aud.gam) :: - ++ deli ::< find number - ::> gets absolute message number from relative. + ++ deli + :> gets absolute message number from relative. :: |= {max/@ud nul/@u fin/@ud} ^- @ud @@ -992,9 +1057,11 @@ =- ?:((lte - max) - (sub - dog)) (add fin (sub max (mod max dog))) :: - ++ set-glyph ::< new glyph binding - ::> applies glyph binding to our state and sends - ::> an action. + ++ set-glyph + :> new glyph binding + :> + :> applies glyph binding to our state and sends + :> an action. :: |= {cha/char aud/audience} =: bound (~(put by bound) aud cha) @@ -1002,9 +1069,11 @@ == sh-prod:(sh-act %glyph cha aud &) :: - ++ unset-glyph ::< old glyph binding - ::> removes either {aud} or all bindings on a - ::> glyph and sends an action. + ++ unset-glyph + :> remote old glyph binding + :> + :> removes either {aud} or all bindings on a + :> glyph and sends an action. :: |= {cha/char aud/(unit audience)} =/ ole/(set audience) @@ -1020,8 +1089,8 @@ binds (~(del ju binds) cha n.ole) == :: - ++ reverse-nicks ::< find by handle - ::> finds all ships whose handle matches {nym}. + ++ reverse-nicks + :> finds all ships whose handle matches {nym}. :: |= nym/^nick ^- (list ship) @@ -1030,137 +1099,176 @@ ?. =(q nym) ~ [~ u=p] :: - ++ hoon-head ::< eval data - ::> makes a vase of environment data to evaluate - ::> against (for #-messages). + ++ hoon-head + :> eval data + :> + :> makes a vase of environment data to evaluate + :> against (for #-messages). :: ^- vase !> ^- {our/@p now/@da eny/@uvI} - [our now.bol (shas %eny eny.bol)] + [self now.bol (shas %eny eny.bol)] :: - ::> || - ::> || %circle-management - ::> || - ::+| + :> # + :> # %circle-management + :> # + +| :: - ++ join ::< %join - ::> change local mailbox config to include - ::> subscriptions to {pas}. + ++ join + :> %join + :> + :> change local mailbox config to include + :> subscriptions to {pas}. :: |= pos/(map circle range) ^+ ..sh-work =+ pas=~(key by pos) =. ..sh-work sh-prod(active.she pas) + :: default to a day of backlog + =. pos + %- ~(run by pos) + |= r/range + ?~(r `[da+(sub now.bol ~d1) ~] r) (sh-act %source inbox & pos) :: - ++ leave ::< %leave - ::> change local mailbox config to exclude - ::> subscriptions to {pas}. + ++ leave + :> %leave + :> + :> change local mailbox config to exclude + :> subscriptions to {pas}. :: |= pas/(set circle) ^+ ..sh-work + :: remove *all* sources relating to {pas}. =/ pos - %- ~(run in pas) - |=(p/circle [p ~]) + %- ~(gas in *(set ^source)) + %- zing + =/ sos + =- ~(tap in src:-) + (fall (~(get by mirrors) incir) *config) + %+ turn ~(tap in pas) + |= c/circle + %+ skim sos + |=(s/^source =(cir.s c)) =. ..sh-work (sh-act %source inbox | pos) (sh-act %notify pas ~) :: - ++ create ::< %create - ::> creates circle {nom} with specified config. + ++ create + :> %create + :> + :> creates circle {nom} with specified config. :: - |= {sec/security nom/naem txt/cord} + |= {sec/security nom/name txt/cord} ^+ ..sh-work =. ..sh-work (sh-act %create nom txt sec) - (join [[[our nom] ~] ~ ~]) + (join [[[self nom] ~] ~ ~]) :: - ++ delete ::< %delete - ::> deletes our circle {nom}, after optionally - ::> sending a last announce message {say}. + ++ delete + :> %delete + :> + :> deletes our circle {nom}, after optionally + :> sending a last announce message {say}. :: - |= {nom/naem say/(unit cord)} + |= {nom/name say/(unit cord)} ^+ ..sh-work (sh-act %delete nom say) :: - ++ depict ::< %depict - ::> changes the description of {nom} to {txt}. + ++ depict + :> %depict + :> + :> changes the description of {nom} to {txt}. :: - |= {nom/naem txt/cord} + |= {nom/name txt/cord} ^+ ..sh-work (sh-act %depict nom txt) :: - ++ permit ::< %invite / %banish - ::> invites or banishes {sis} to/from our - ::> circle {nom}. + ++ permit + :> %invite / %banish + :> + :> invites or banishes {sis} to/from our + :> circle {nom}. :: - |= {inv/? nom/naem sis/(set ship)} + |= {inv/? nom/name sis/(set ship)} ^+ ..sh-work - (sh-act %permit nom inv sis) + =. ..sh-work (sh-act %permit nom inv sis) + =- (sh-act %phrase - [%inv inv [self nom]]~) + %- ~(rep in sis) + |= {s/ship a/audience} + (~(put in a) [s %inbox]) :: ++ filter - |= {nom/naem cus/? utf/?} + |= {nom/name cus/? utf/?} ^+ ..sh-work (sh-act %filter nom cus utf) :: - ++ source ::< %source - ::> adds {pas} to {nom}'s src. + ++ source + :> %source + :> + :> adds {pas} to {nom}'s src. :: - |= {sub/? nom/naem pos/(map circle range)} + |= {sub/? nom/name pos/(map circle range)} ^+ ..sh-work (sh-act %source nom sub pos) :: - ::> || - ::> || %personal-metadata - ::> || - ::+| + :> # + :> # %personal-metadata + :> # + +| :: - ++ attend ::< set our presence - ::> sets our presence to {pec} for {aud}. + ++ attend + :> sets our presence to {pec} for {aud}. :: |= {aud/audience pec/(unit presence)} ^+ ..sh-work (sh-act %notify aud pec) :: - ++ name ::< set our name - ::> sets our name to {man} for {aud}. + ++ set-name + :> sets our name to {man} for {aud}. :: |= {aud/audience man/human} ^+ ..sh-work (sh-act %naming aud man) :: - ::> || - ::> || %messaging - ::> || - ::+| + :> # + :> # %messaging + :> # + +| :: - ++ say ::< publish - ::> sends message. + ++ say + :> sends message. :: |= sep/(list speech) ^+ ..sh-work (sh-act %phrase active.she sep) :: - ++ eval ::< run - ::> executes {exe} and sends both its code and - ::> result. + ++ eval + :> run + :> + :> executes {exe} and sends both its code and + :> result. :: |= {txt/cord exe/hoon} => |.([(sell (slap (slop hoon-head seed) exe))]~) =+ tan=p:(mule .) (say [%exp txt tan] ~) :: - ++ target ::< %target - ::> sets messaging target, then execute {woe}. + ++ target + :> %target + :> + :> sets messaging target, then execute {woe}. :: |= {aud/audience woe/(unit ^work)} ^+ ..sh-work =. ..sh-pact (sh-pact aud) ?~(woe ..sh-work work(job u.woe)) :: - ++ reply ::< %reply - ::> send a reply to the selected message. + ++ reply + :> %reply + :> + :> send a reply to the selected message. :: |= {num/$@(@ud {p/@u q/@ud}) sep/(list speech)} ^+ ..sh-work @@ -1176,13 +1284,15 @@ uid:(snag (sub count +(msg)) grams) (say (turn sep |=(s/speech [%ire ser s]))) :: - ::> || - ::> || %displaying-info - ::> || - ::+| + :> # + :> # %displaying-info + :> # + +| :: - ++ who ::< %who - ::> prints presence lists for {cis} or all. + ++ who + :> %who + :> + :> prints presence lists for {cis} or all. :: |= cis/(set circle) ^+ ..sh-work =< (sh-fact %mor (murn (sort ~(tap by remotes) aor) .)) @@ -1201,8 +1311,10 @@ $talk `leaf+:(weld "talk " (scow %p a) " " (trip (fall han.c ''))) == :: - ++ what ::< %what - ::> prints binding details. goes both ways. + ++ what + :> %what + :> + :> prints binding details. goes both ways. :: |= qur/(unit $@(char audience)) ^+ ..sh-work @@ -1227,8 +1339,10 @@ ^- (list sole-effect) [%txt [gyf ' ' ~(ar-phat ar a)]]~ :: - ++ number ::< %number - ::> finds selected message, expand it. + ++ number + :> %number + :> + :> finds selected message, expand it. :: |= num/$@(@ud {p/@u q/@ud}) ^+ ..sh-work @@ -1238,7 +1352,7 @@ (sh-lame "{(scow %s (new:si | +(num)))}: no such telegram") =. ..sh-fact (sh-fact %txt "? {(scow %s (new:si | +(num)))}") (activate (snag num grams)) - ?. (gth q.num count) + ?. (gte q.num count) ?: =(count 0) (sh-lame "0: no messages") =+ msg=(deli (dec count) num) @@ -1246,13 +1360,50 @@ (activate (snag (sub count +(msg)) grams)) (sh-lame "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram") :: - ::> || - ::> || %ui-settings - ::> || - ::+| + ++ circles + :> %circles + :> + :> list all local circles. + :: + ^+ ..sh-work + =/ piz + =- .^(prize %gx -) + %+ weld /(scot %p our.bol)/hall/(scot %da now.bol) + /circles/(scot %p our.bol)/hall-prize + ?> ?=($circles -.piz) + %+ sh-fact %mor + %+ turn (sort ~(tap in cis.piz) lth) + |= a/name [%txt "%{(trip a)}"] :: - ++ bind ::< %bind - ::> binds targets {aud} to the glyph {cha}. + ++ list-sources + :> %sources + :> + :> display the active sources for our circle. + :: + |= cir/circle + ^+ ..sh-work + %+ sh-fact %mor + %+ turn + :: make sure to exclude {nom} itself. + =- ~(tap in (~(del in src:-) [cir ~])) + (fall (~(get by mirrors) cir) *config) + |= s/^source + ^- sole-effect + :- %txt + %+ weld ~(cr-phat cr cir.s) + %+ roll (range-to-path ran.s) + |= {a/@ta b/tape} + :(weld b "/" (trip a)) + :: + :> # + :> # %ui-settings + :> # + +| + :: + ++ bind + :> %bind + :> + :> binds targets {aud} to the glyph {cha}. :: |= {cha/char aud/(unit audience)} ^+ ..sh-work @@ -1262,8 +1413,10 @@ %. "bound {} {}" sh-note:sh-prod:(set-glyph cha u.aud) :: - ++ unbind ::< %unbind - ::> unbinds targets {aud} to glyph {cha}. + ++ unbind + :> %unbind + :> + :> unbinds targets {aud} to glyph {cha}. :: |= {cha/char aud/(unit audience)} ^+ ..sh-work @@ -1274,27 +1427,29 @@ %. "unbound {}" sh-note:sh-prod:(unset-glyph cha aud) :: - ++ nick ::< %nick - ::> either shows, sets or unsets nicknames - ::> depending on arguments. + ++ nick + :> %nick + :> + :> either shows, sets or unsets nicknames + :> depending on arguments. :: |= {her/(unit ship) nym/(unit ^nick)} ^+ ..sh-work - ::> no arguments, show all + :: no arguments, show all ?: ?=({$~ $~} +<) %+ sh-fact %mor %+ turn ~(tap by nicks) |= {p/ship q/^nick} :- %txt "{

}: {}" - ::> show her nick + :: show her nick ?~ nym ?> ?=(^ her) =+ asc=(~(get by nicks) u.her) %+ sh-fact %txt ?~ asc "{} unbound" "{}: {}" - ::> show nick ship + :: show nick ship ?~ her %+ sh-fact %mor %+ turn (reverse-nicks u.nym) @@ -1304,14 +1459,16 @@ %= sh-act nicks ?~ u.nym - ::> unset nickname + :: unset nickname (~(del by nicks) u.her) - ::> set nickname + :: set nickname (~(put by nicks) u.her u.nym) == :: - ++ wo-set ::< %set - ::> enables ui setting flag. + ++ wo-set + :> %set + :> + :> enables ui setting flag. :: |= seg/term ^+ ..sh-work @@ -1324,8 +1481,10 @@ settings.she (~(put in settings.she) seg) == :: - ++ unset ::< %unset - ::> disables ui setting flag. + ++ unset + :> %unset + :> + :> disables ui setting flag. :: |= neg/term ^+ ..sh-work @@ -1333,63 +1492,77 @@ settings.she (~(del in settings.she) neg) == :: - ++ width ::< ;set width - ::> change the display width in cli. + ++ width + :> ;set width + :> + :> change the display width in cli. :: |= wid/@ud ^+ ..sh-work ..sh-work(width.she (max 30 wid)) :: - ++ timez ::< ;set timezone - ::> adjust the displayed timestamp. + ++ timez + :> ;set timezone + :> + :> adjust the displayed timestamp. :: |= tim/(pair ? @ud) ^+ ..sh-work ..sh-work(timez.she tim) :: - ::> || - ::> || %miscellaneous - ::> || - ::+| + :> # + :> # %miscellaneous + :> # + +| :: - ++ public ::< show/hide membership - ::> adds or removes the circle from the public - ::> membership list. + ++ public + :> show/hide membership + :> + :> adds or removes the circle from the public + :> membership list. :: |= {add/? cir/circle} (sh-act %public add cir) :: - ++ help ::< %help - ::> prints help message + ++ help + :> %help + :> + :> prints help message :: (sh-fact %txt "see http://urbit.org/docs/using/messaging/") -- :: - ++ sh-pact ::< update active aud - ::> change currently selected audience to {aud} - ::> and update the prompt. + ++ sh-pact + :> update active aud + :> + :> change currently selected audience to {aud} + :> and update the prompt. :: |= aud/audience ^+ +> - ::> ensure we can see what we send. + :: ensure we can see what we send. =+ act=(sh-pare aud) ?: =(active.she act) +>.$ sh-prod(active.she act) :: - ++ sh-pare ::< adjust target list - ::> if the audience {aud} does not contain a - ::> circle we're subscribed to, add our mailbox - ::> to the audience (so that we can see our own - ::> message). + ++ sh-pare + :> adjust target list + :> + :> if the audience {aud} does not contain a + :> circle we're subscribed to, add our mailbox + :> to the audience (so that we can see our own + :> message). :: |= aud/audience ?: (sh-pear aud) aud (~(put in aud) incir) :: - ++ sh-pear ::< hearback - ::> produces true if any circle is included in - ::> our subscriptions, meaning, we hear messages - ::> sent to {aud}. + ++ sh-pear + :> hearback + :> + :> produces true if any circle is included in + :> our subscriptions, meaning, we hear messages + :> sent to {aud}. :: |= aud/audience ?~ aud | @@ -1398,33 +1571,37 @@ $(aud r.aud) == :: - ++ sh-glyf ::< decode glyph - ::> finds the circle(s) that match a glyph. + ++ sh-glyf + :> decode glyph + :> + :> finds the circle(s) that match a glyph. :: |= cha/char ^- (unit audience) =+ lax=(~(get ju binds) cha) - ::> no circle. + :: no circle. ?: =(~ lax) ~ - ::> single circle. + :: single circle. ?: ?=({* $~ $~} lax) `n.lax - ::> in case of multiple audiences, pick the most recently active one. + :: in case of multiple audiences, pick the most recently active one. |- ^- (unit audience) ?~ grams ~ - ::> get first circle from a telegram's audience. + :: get first circle from a telegram's audience. =+ pan=(silt ~(tap in aud.i.grams)) ?: (~(has in lax) pan) `pan $(grams t.grams) :: - ::> || - ::> || %differs - ::> || - ::> arms that calculate differences between datasets. - ::+| + :> # + :> # %differs + :> # + :> arms that calculate differences between datasets. + +| :: - ++ sh-group-diff ::< group diff parts - ::> calculates the difference between two presence - ::> lists, producing lists of removed, added and - ::> changed presences. + ++ sh-group-diff + :> group diff parts + :> + :> calculates the difference between two presence + :> lists, producing lists of removed, added and + :> changed presences. :: |= {one/group two/group} =| $= ret @@ -1459,10 +1636,12 @@ ret ret :: - ++ sh-rempe-diff ::< remotes diff - ::> calculates the difference between two remote - ::> presence maps, producing a list of removed, - ::> added and changed presences maps. + ++ sh-rempe-diff + :> remotes diff + :> + :> calculates the difference between two remote + :> presence maps, producing a list of removed, + :> added and changed presences maps. :: |= {one/(map circle group) two/(map circle group)} =| $= ret @@ -1491,10 +1670,12 @@ ret(new [i.owt new.ret]) ret :: - ++ sh-remco-diff ::< config diff parts - ::> calculates the difference between two config - ::> maps, producing lists of removed, added and - ::> changed configs. + ++ sh-remco-diff + :> config diff parts + :> + :> calculates the difference between two config + :> maps, producing lists of removed, added and + :> changed configs. :: |= {one/(map circle config) two/(map circle config)} =| $= ret @@ -1523,38 +1704,49 @@ ret(new [i.owt new.ret]) ret :: - ++ sh-set-diff ::< set diff - ::> calculates the difference between two sets, - ::> procuding lists of removed and added items. + ++ sh-set-diff + :> set diff + :> + :> calculates the difference between two sets, + :> procuding lists of removed and added items. :: |* {one/(set *) two/(set *)} :- ^= old ~(tap in (~(dif in one) two)) ^= new ~(tap in (~(dif in two) one)) :: - ::> || - ::> || %printers - ::> || - ::> arms for printing data to the cli. - ::+| + :> # + :> # %printers + :> # + :> arms for printing data to the cli. + +| :: - ++ sh-lame ::< send error - ::> just puts some text into the cli as-is. + ++ sh-lame + :> send error + :> + :> just puts some text into the cli as-is. :: |= txt/tape (sh-fact [%txt txt]) :: - ++ sh-note ::< shell message - ::> left-pads {txt} with heps and prints it. + ++ sh-note + :> shell message + :> + :> left-pads {txt} with heps and prints it. :: |= txt/tape ^+ +> - %+ sh-fact %txt - %+ runt [14 '-'] - `tape`['|' ' ' (scag (sub width.she 16) txt)] + =+ lis=(simple-wrap txt (sub width.she 16)) + %+ sh-fact %mor + =+ ?:((gth (lent lis) 0) (snag 0 lis) "") + :- txt+(runt [14 '-'] '|' ' ' -) + %+ turn (slag 1 lis) + |=(a/tape txt+(runt [14 ' '] '|' ' ' a)) :: - ++ sh-prod ::< show prompt - ::> makes and stores a move to modify the cli - ::> prompt to display the current audience. + ++ sh-prod + :> show prompt + :> + :> makes and stores a move to modify the cli + :> prompt to display the current audience. :: ^+ . %+ sh-fact %pro @@ -1567,8 +1759,8 @@ =+ por=~(ar-prom ar q.rew) (weld `tape`[p.p.rew por] `tape`[q.p.rew ' ' ~]) :: - ++ sh-rend ::< print telegram - ::> prints a telegram as rendered by ++tr-rend. + ++ sh-rend + :> prints a telegram as rendered by ++tr-rend. :: |= gam/telegram ^+ +> @@ -1576,7 +1768,7 @@ ?~ lis +>.$ %+ sh-fact %mor %+ turn `(list tape)`lis - =+ nom=(scag 7 (cite:title our)) + =+ nom=(scag 7 (cite:title self)) |= t/tape ?. ?& (~(has in settings.she) %notify) ?=(^ (find nom (slag 15 t))) @@ -1584,8 +1776,8 @@ [%txt t] [%mor [%txt t] [%bel ~] ~] :: - ++ sh-numb ::< print msg number - ::> prints a message number, left-padded by heps. + ++ sh-numb + :> prints a message number, left-padded by heps. :: |= num/@ud ^+ +> @@ -1593,22 +1785,24 @@ %+ sh-fact %txt (runt [(sub 13 (lent bun)) '-'] "[{bun}]") :: - ++ sh-cure ::< readable security - ::> renders a security kind. + ++ sh-cure + :> renders a security kind. :: |= a/security ^- tape (scow %tas a) :: - ++ sh-scis ::< render status - ::> gets the presence of {saz} as a tape. + ++ sh-scis + :> render status + :> + :> gets the presence of {saz} as a tape. :: |= sat/status ^- tape ['%' (trip pec.sat)] :: - ++ sh-show-status ::< print status diff - ::> prints presence changes to the cli. + ++ sh-show-status + :> prints presence changes to the cli. :: |= {cir/circle who/ship cur/status dif/diff-status} ^+ +> @@ -1638,8 +1832,8 @@ "bye {(scow %p who)}" == :: - ++ sh-show-config ::< show config - ::> prints config changes to the cli. + ++ sh-show-config + :> prints config changes to the cli. :: |= {cir/circle cur/config dif/diff-config} ^+ +> @@ -1651,6 +1845,7 @@ $(dif [%filter fit.cof.dif]) ?: ?=($remove -.dif) (sh-note (weld "rip " (~(cr-show cr cir) ~))) + ?: ?=($usage -.dif) +> %- sh-note %+ weld (weld ~(cr-phat cr cir) ": ") @@ -1686,9 +1881,11 @@ (weld t (cite:title s)) == :: - ++ sh-gram ::< show telegram - ::> prints the telegram. every fifth message, - ::> print the message number also. + ++ sh-gram + :> show telegram + :> + :> prints the telegram. every fifth message, + :> print the message number also. :: |= gam/telegram ^+ +> @@ -1702,39 +1899,42 @@ (sh-numb num) (sh-rend(latest.she num) gam) :: - ++ sh-grams ::< do show telegrams - ::> prints multiple telegrams. + ++ sh-grams + :> prints multiple telegrams. :: |= gaz/(list telegram) ^+ +> ?~ gaz +> $(gaz t.gaz, +> (sh-gram i.gaz)) - :: -- -- :: -::> || -::> || %renderers -::> || -::> rendering cores. -::+| +:> # +:> # %renderers +:> # +:> rendering cores. ++| :: -++ cr ::< circle renderer - ::> used in both circle and ship rendering. +++ cr + :> circle renderer + :> + :> used in both circle and ship rendering. :: - |_ ::> one: the circle. + |_ :> one: the circle. :: one/circle :: - ++ cr-beat ::< {one} more relevant? - ::> returns true if one is better to show, false - ::> otherwise. prioritizes: our > main > size. + ++ cr-beat + :> {one} more relevant? + :> + :> returns true if one is better to show, false + :> otherwise. prioritizes: our > main > size. :: |= two/circle ^- ? :: the circle that's ours is better. - ?: =(our hos.one) - ?. =(our hos.two) & + ?: =(self hos.one) + ?. =(self hos.two) & ?< =(nom.one nom.two) :: if both circles are ours, the main story is better. ?: =(%inbox nom.one) & @@ -1742,32 +1942,34 @@ :: if neither are, pick the "larger" one. (lth nom.one nom.two) :: if one isn't ours but two is, two is better. - ?: =(our hos.two) | + ?: =(self hos.two) | ?: =(hos.one hos.two) :: if they're from the same ship, pick the "larger" one. (lth nom.one nom.two) :: if they're from different ships, neither ours, pick hierarchically. (lth (xeb hos.one) (xeb hos.two)) :: - ++ cr-best ::< get most relevant - ::> returns the most relevant circle. + ++ cr-best + :> returns the most relevant circle. :: |= two/circle ?:((cr-beat two) one two) :: - ++ cr-curt ::< render name in 14 - ::> prints a ship name in 14 characters. left-pads - ::> with spaces. {mup} signifies "are there other - ::> targets besides this one?" + ++ cr-curt + :> prints a ship name in 14 characters. + :> + :> left-pads with spaces. {mup} signifies + :> "are there other targets besides this one?" :: |= mup/? ^- tape =+ raw=(cite:title hos.one) (runt [(sub 14 (lent raw)) ' '] raw) :: - ++ cr-nick ::< nick or name in 14 - ::> get nick for ship, or shortname if no nick. - ::> left-pads with spaces. + ++ cr-nick + :> get nick for ship, or shortname if no nick. + :> + :> left-pads with spaces. :: |= aud/audience ^- tape @@ -1785,6 +1987,9 @@ =+ len=(sub 14 (lent raw)) (weld (reap len ' ') raw) :: + :: todo: figure out why enabling the doccord causes a nest fail, even when + :: attached to the arm instead of the product. + :: ++ cr-phat ::< render accurately ::> prints a circle fully, but still taking ::> "shortcuts" where possible: @@ -1793,23 +1998,23 @@ ::> "/channel" for parent circle. :: ^- tape - ?: =(hos.one our) + ?: =(hos.one self) ?: =(nom.one inbox) ":" ['%' (trip nom.one)] =+ wun=(cite:title hos.one) ?: =(nom.one %inbox) wun - ?: =(hos.one (sein:title our)) + ?: =(hos.one (sein:title self)) ['/' (trip nom.one)] :(welp wun "/" (trip nom.one)) :: - ++ cr-full (cr-show ~) ::< render full width + ++ cr-full (cr-show ~) :< render full width :: - ++ cr-show ::< render circle - ::> renders a circle as text. - :: - ::> moy: multiple circles in audience? + ++ cr-show + :> renders a circle as text. + :> + :> moy: multiple circles in audience? |= moy/(unit ?) ^- tape :: render circle (as glyph if we can). @@ -1820,16 +2025,18 @@ (~(cr-curt cr one) u.moy) -- :: -++ ar ::< audience renderer - ::> used for representing audiences (sets of circles) - ::> as tapes. +++ ar + :> audience renderer + :> + :> used for representing audiences (sets of circles) + :> as tapes. :: - |_ ::> aud: members of the audience. + |_ :> aud: members of the audience. :: aud/audience :: - ++ ar-best ::< most relevant - ::> find the most relevant circle in the set. + ++ ar-best + :> find the most relevant circle in the set. :: ^- (unit circle) ?~ aud ~ @@ -1841,22 +2048,24 @@ =? n.aud ?=(^ rit) (~(cr-best cr n.aud) u.rit) n.aud :: - ++ ar-deaf ::< except for self - ::> remove ourselves from the audience. + ++ ar-deaf + :> remove ourselves from the audience. :: ^+ . .(aud (~(del in aud) `circle`incir)) :: - ++ ar-maud ::< multiple audience - ::> checks if there's multiple circles in the - ::> audience via pattern matching. + ++ ar-maud + :> multiple audience + :> + :> checks if there's multiple circles in the + :> audience via pattern matching. :: ^- ? =. . ar-deaf !?=($@($~ {* $~ $~}) aud) :: - ++ ar-phat ::< render full-size - ::> render all circles, no glyphs. + ++ ar-phat + :> render all circles, no glyphs. :: ^- tape %- ~(rep in aud) @@ -1865,8 +2074,8 @@ (weld t ", ") (weld t ~(cr-phat cr c)) :: - ++ ar-prom ::< render targets - ::> render all circles, ordered by relevance. + ++ ar-prom + :> render all circles, ordered by relevance. :: ^- tape =. . ar-deaf @@ -1883,21 +2092,25 @@ $(all t.all, fir |) == :: - ++ ar-whom ::< render sender - ::> render sender as the most relevant circle. + ++ ar-whom + :> render sender as the most relevant circle. :: (~(cr-show cr (need ar-best)) ~ ar-maud) :: - ++ ar-dire ::< direct message - ::> returns true if circle is a mailbox of ours. + ++ ar-dire + :> returns true if circle is a mailbox of ours. :: |= cir/circle ^- ? - ?& =(hos.cir our) + ?& =(hos.cir self) =+ sot=(~(get by mirrors) cir) &(?=(^ sot) ?=($mailbox sec.con.u.sot)) == :: - ++ ar-glyf ::< audience glyph + ++ ar-glyf + :: todo: another place where doccords break things. + :: + ::> audience glyph + ::> ::> get the glyph that corresponds to the audience. ::> for mailbox messages and complex audiences, use ::> reserved "glyphs". @@ -1912,21 +2125,19 @@ ";" -- :: -++ tr ::< telegram renderer - ::> responsible for converting telegrams and - ::> everything relating to them to text to be - ::> displayed in the cli. +++ tr + :> telegram renderer + :> + :> responsible for converting telegrams and + :> everything relating to them to text to be + :> displayed in the cli. :: - |_ $: ::> sef: settings flags. - ::> \ telegram - ::> who: author. - ::> \ thought - ::> sen: unique identifier. - ::> aud: audience. - ::> \ statement - ::> wen: timestamp. - ::> bou: complete aroma. - ::> sep: message contents. + |_ $: :> sef: settings flags. + :> who: author. + :> sen: unique identifier. + :> aud: audience. + :> wen: timestamp. + :> sep: message contents. :: sef/(set term) who/ship @@ -1936,17 +2147,20 @@ sep/speech == :: - ++ tr-fact ::< activate effect - ::> produces sole-effect for printing message - ::> details. + ++ tr-fact + :> activate effect + :> + :> produces sole-effect for printing message + :> details. :: ^- sole-effect ~[%mor [%tan tr-meta] tr-body] :: - ++ tr-rend ::< render telegram - ::> renders a telegram. - ::> the first line will contain the author and - ::> optional timestamp. + ++ tr-rend + :> renders a telegram + :> + :> the first line will contain the author and + :> optional timestamp. :: ^- (list tape) =/ wyd @@ -1990,9 +2204,11 @@ ?~ l [:(weld nom t tam) ~] [(weld den t) l] :: - ++ tr-meta ::< metadata - ::> builds string that display metadata, including - ::> message serial, timestamp, author and audience. + ++ tr-meta + :> metadata + :> + :> builds string that display metadata, including + :> message serial, timestamp, author and audience. :: ^- tang =. wen (sub wen (mod wen (div wen ~s0..0001))) :: round @@ -2003,9 +2219,11 @@ leaf+~(cr-full cr a) [%rose [" " ~ ~] [hed >who< [%rose [", " "to " ~] cis] ~]]~ :: - ++ tr-body ::< message content - ::> long-form display of message contents, specific - ::> to each speech type. + ++ tr-body + :> message content + :> + :> long-form display of message contents, specific + :> to each speech type. :: |- ^- sole-effect ?- -.sep @@ -2019,12 +2237,15 @@ mor+~[txt+"# {(trip exp.sep)}" tan+res.sep] :: $ire - =+ gam=(recall top.sep) - ?~ gam $(sep sep.sep) + =+ num=(~(get by known) top.sep) + ?~ num $(sep sep.sep) + =+ gam=(snag (sub count +(u.num)) grams) =- mor+[tan+- $(sep sep.sep) ~] %- flop %+ weld - [%leaf "in reply to: {(cite:title aut.u.gam)}: "]~ - %+ turn (~(tr-text tr sef u.gam) width.cli) + :_ ~ :- %leaf + %+ weld "in reply to: {(cite:title aut.gam)}: " + "[{(scow %ud u.num)}]" + %+ turn (~(tr-text tr sef gam) width.cli) |=(t/tape [%leaf t]) :: $fat @@ -2044,8 +2265,8 @@ [%mor tan+~[leaf+"[{(trip app.sep)}]: "] $(sep sep.sep) ~] == :: - ++ tr-tach ::< attachment - ::> renders an attachment. + ++ tr-tach + :> renders an attachment. :: |= a/attache ^- tang @@ -2055,10 +2276,12 @@ $text (turn (flop +.a) |=(b/cord leaf+(trip b))) == :: - ++ tr-chow ::< truncate - ::> truncates the {txt} to be of max {len} - ::> characters. if it does truncate, indicates it - ::> did so by appending _ or …. + ++ tr-chow + :> truncate + :> + :> truncates the {txt} to be of max {len} + :> characters. if it does truncate, indicates it + :> did so by appending _ or …. :: |= {len/@u txt/tape} ^- tape @@ -2075,13 +2298,15 @@ ?~ t.txt "…" [i.txt $(txt t.txt)] :: - ++ tr-text ::< compact contents - ::> renders just the most important data of the - ::> message. if possible, these stay within a single - ::> line. + ++ tr-text + :> compact contents + :> + :> renders just the most important data of the + :> message. if possible, these stay within a single + :> line. + :> + :> pre: replace/append line prefix ::TODO this should probably be redone someday. - :: - ::> pre: replace/append line prefix =| pre/(unit (pair ? tape)) |= wyd/@ud ^- (list tape) @@ -2132,20 +2357,18 @@ ?: pat.sep " " =- (weld - q:(fall pre [p=| q=" "])) %~ ar-glyf ar - ?: =(who our) aud + ?: =(who self) aud (~(del in aud) [who %inbox]) == - =. wyd (sub wyd (min (div wyd 2) (lent pef))) - =/ txt (tuba (trip msg.sep)) - |- ^- (list tape) - ?~ txt ~ - =+ ^- {end/@ud nex/?} - ?: (lte (lent txt) wyd) [(lent txt) &] - =+ ace=(find " " (flop (scag +(wyd) `(list @c)`txt))) - ?~ ace [wyd |] - [(sub wyd u.ace) &] - :- (weld pef (tufa (scag end `(list @c)`txt))) - $(txt (slag ?:(nex +(end) end) `(list @c)`txt), pef (reap (lent pef) ' ')) + =/ lis/(list tape) + %+ simple-wrap + `tape``(list @)`(tuba (trip msg.sep)) + (sub wyd (min (div wyd 2) (lent pef))) + =+ lef=(lent pef) + =+ ?:((gth (lent lis) 0) (snag 0 lis) "") + :- (weld pef -) + %+ turn (slag 1 lis) + |=(a/tape (runt [lef ' '] a)) :: $inv :_ ~ @@ -2161,10 +2384,10 @@ == -- :: -::> || -::> || %events -::> || -::+| +:> # +:> # %events +:> # ++| :: ++ quit-server-client |= wir/wire @@ -2176,62 +2399,87 @@ ^- (quip move _+>) [[peer-inbox]~ +>] :: -++ peer ::< accept subscription - ::> incoming subscription on pax. +++ peer + :> incoming subscription on pax. :: |= pax/path ^- (quip move _+>) - ?. (team:title src.bol our.bol) - ~& [%peer-talk-stranger src.bol] - [~ +>] + ?. =(src.bol our.bol) + ~! [%peer-talk-stranger src.bol] + !! ?. ?=({$sole *} pax) - ~& [%peer-talk-strange pax] - [~ +>] + ~! [%peer-talk-strange pax] + !! ta-done:ta-console:ta :: -++ diff-hall-prize ::< accept query answer - ::> +++ diff-hall-prize + :> accept query answer :: |= {way/wire piz/prize} ^- (quip move _+>) ta-done:(ta-take:ta piz) :: -++ diff-hall-rumor ::< accept query change - ::> +++ diff-hall-rumor + :> accept query change :: |= {way/wire rum/rumor} ^- (quip move _+>) ta-done:(ta-hear:ta rum) :: -++ poke-sole-action ::< accept console - ::> incoming sole action. process it. +++ poke-sole-action + :> incoming sole action. process it. :: |= act/sole-action ta-done:(ta-sole:ta act) :: ::TODO for debug purposes. remove eventually. +:: users beware, here be dragons. ++ poke-noun |= a/@t ^- (quip move _+>) - ?: =(a 'debug') + ?: =(a 'check') + ~& 'verifying message reference integrity...' =- ~&(- [~ +>.$]) + ~& [%count--lent count (lent grams)] =+ %- ~(rep by known) |= {{u/serial a/@ud} k/@ud m/@ud} :- ?:((gth a k) a k) ?: =(u uid:(snag (sub count +(a)) grams)) m +(m) - :^ %check-talk - count=count - lent=(lent grams) + :- %check-talk [known=k mismatch=m] ?: =(a 'rebuild') + ~& 'rebuilding message references...' =+ %+ reel grams |= {t/telegram c/@ud k/(map serial @ud)} [+(c) (~(put by k) uid.t c)] [~ +>.$(count c, known k)] + ?: =(a 'reconnect') + ~& 'disconnecting and reconnecting to hall...' + :_ +> + :~ [ost.bol %pull /server/client server ~] + [ost.bol %pull /server/inbox server ~] + peer-client + peer-inbox + == + ?: =(a 'reset') + ~& 'full reset incoming, hold on to your cli...' + :_ +>(grams ~, known ~, count 0, last 0) + :~ [ost.bol %pull /server/client server ~] + [ost.bol %pull /server/inbox server ~] + peer-client + peer-inbox + == + :: this deletes a message from your backlog, and may + :: make talk throw stack traces. + :: **aka don't run this!** + ?: =(a 'screw') + ~& 'screwing things up...' + :- ~ + +>(grams (oust [0 1] grams)) [~ +>] :: -++ coup-client-action ::< accept n/ack - ::> +++ coup-client-action + :> accept n/ack :: |= {wir/wire fal/(unit tang)} ^- (quip move _+>) diff --git a/app/twit.hoon b/app/twit.hoon index d829cd2ef..a374136a4 100644 --- a/app/twit.hoon +++ b/app/twit.hoon @@ -195,11 +195,11 @@ |= {usr/(unit user:eyre) req/(unit user:eyre)} ?~(req & =(usr req)) :: -:: .^(twit-feed %gx /=twit=/~/home/urbit_test) -:: .^(twit-stat %gx /=twit=/~./post/0vv0old.0post.hash0.0000) -++ peek - |= {ren/care:clay pax/path} ^- (unit (unit gilt)) - ?> ?=($x ren) :: others unsupported +:: /+ 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] !!) @@ -213,7 +213,7 @@ ++ peer-scry-x |= pax/path ^+ done :_ +> - =+ pek=(peek %x pax) + =+ pek=(peek-x pax) ?^ pek ?~ u.pek ~|(bad-scry+x+pax !!) ~[[ost %diff u.u.pek] [ost %quit ~]] diff --git a/gen/capitalize.hoon b/gen/capitalize.hoon new file mode 100644 index 000000000..f5bff918d --- /dev/null +++ b/gen/capitalize.hoon @@ -0,0 +1,285 @@ +:: to use, download UnicdoeData.txt and place it in `%/lib/unicode-data/txt`. +:: +:::: +:: +:: part 1: parse the file into {uppers} +:: +/- unicode-data +/+ new-hoon +/= case-table + /; |= a=(list line:unicode-data) + =, new-hoon + |^ %- build-tree + %- flop + (build-case-nodes a) + :: + :> # + :> # %case-nodes + :> # + :> transforms raw unicode data into sequential case nodes. + +| + ++ build-case-nodes + :> raw list of unicode data lines to a compact list of chardata + |= a=(list line:unicode-data) + ^- (list case-node:unicode-data) + =< out + :: + :: 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. + :: + %^ foldl:ls a *case-fold + |= [c=case-fold l=line:unicode-data] + ^+ c + =+ state=(line-to-case-state l) + ?: (is-adjacent state prev.c) + c(prev state) + =. c (add-range c) + %= c + start + ?: &(!=(case.state %missing) !=(case.state %none)) + `state + ~ + prev 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]) + :: + ++ 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 + == + :: + :> # + :> # %tree-building + :> # + :> builds a binary search tree out of the list + +| + ++ 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. + ?~ a + ~ + =+ len=(lent a) + =+ [lhs rhs]=(split-at:ls (div len 2) 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) diff --git a/gen/hood/private.hoon b/gen/hood/private.hoon new file mode 100644 index 000000000..bcfe62ff4 --- /dev/null +++ b/gen/hood/private.hoon @@ -0,0 +1,10 @@ +:: Kiln: make (subtree in) desk privately readable. +:: +:::: /gen/hood/private/hoon + :: +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + {arg/{des/desk may/?($~ {pax/path $~})} $~} + == +:- %kiln-permission +[des ?~(may / pax.may) |]:arg diff --git a/gen/hood/public.hoon b/gen/hood/public.hoon new file mode 100644 index 000000000..eea1bcba7 --- /dev/null +++ b/gen/hood/public.hoon @@ -0,0 +1,10 @@ +:: Kiln: make (subtree in) desk publicly readable. +:: +:::: /gen/hood/public/hoon + :: +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + {arg/{des/desk may/?($~ {pax/path $~})} $~} + == +:- %kiln-permission +[des ?~(may / pax.may) &]:arg diff --git a/gen/hood/tlon/add-fora.hoon b/gen/hood/tlon/add-fora.hoon new file mode 100644 index 000000000..2ce32b8fb --- /dev/null +++ b/gen/hood/tlon/add-fora.hoon @@ -0,0 +1,11 @@ +:: tlon: add fora notifications to local urbit-meta +:: +:: make the local urbit-meta pull from {for}'s fora notification channels. +:: +:::: /gen/hood/tlon/add-fora/hoon + :: +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + {{for/ship $~} $~} + == +[%helm-tlon-add-fora for] diff --git a/gen/hood/tlon/add-stream.hoon b/gen/hood/tlon/add-stream.hoon new file mode 100644 index 000000000..dbc29448d --- /dev/null +++ b/gen/hood/tlon/add-stream.hoon @@ -0,0 +1,11 @@ +:: tlon: add stream to local urbit-meta +:: +:: make the local urbit-meta pull from {web}'s stream. +:: +:::: /gen/hood/tlon/add-stream/hoon + :: +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + {{web/ship $~} $~} + == +[%helm-tlon-add-stream web] diff --git a/gen/hood/tlon/init-stream.hoon b/gen/hood/tlon/init-stream.hoon new file mode 100644 index 000000000..3d1be720d --- /dev/null +++ b/gen/hood/tlon/init-stream.hoon @@ -0,0 +1,12 @@ +:: tlon: configure stream ship +:: +:: create a local stream channel and have it pull from +:: {met}'s urbit-meta. +:: +:::: /gen/hood/tlon/init-stream/hoon + :: +:- %say +|= $: {now/@da eny/@uvJ bec/beak} + {{met/ship $~} $~} + == +[%helm-tlon-init-stream met] diff --git a/gen/test.hoon b/gen/test.hoon new file mode 100644 index 000000000..df4c279ff --- /dev/null +++ b/gen/test.hoon @@ -0,0 +1,71 @@ +/+ new-hoon, tester +/= all-tests + /^ (map @ta tests:tester) + /: /===/tests + /_ /test-tree/ +:: +=, new-hoon +|% +:: +++ test-runner + :> run all tests in {a} with a filter. + =| pax=path + |= [filter=path eny=@uvJ a=tests:tester] + ^- tang + %- concat:ls + %+ turn a + |= b=instance:tester + ^- tang + =^ matches filter (match-filter filter p.b) + ?. matches + ~ + ?- -.q.b + %& (run-test [p.b pax] eny p.q.b) + %| ^$(pax [p.b pax], a p.q.b) + == +:: +++ run-test + :> executes an individual test. + |= [pax=path eny=@uvJ test=$-(@uvJ (list tape))] + ^- tang + =+ name=(spud (flop pax)) + =+ run=(mule |.((test eny))) + ?- -.run + $| :: the stack is already flopped for output? + ;: weld + p:run + `tang`[[%leaf (weld name " CRASHED")] ~] + == + $& ?: =(~ p:run) + [[%leaf (weld name " OK")] ~] + :: Create a welded list of all failures indented. + %- flop + ;: weld + `tang`[[%leaf (weld name " FAILED")] ~] + %+ turn p:run + |= {i/tape} + ^- tank + [%leaf (weld " " i)] + == + == +:: +++ match-filter + :> checks to see if {name} matches the head of {filter}. + |= [filter=path name=term] + ^- [? path] + ?~ filter + :: when there's no filter, we always match. + [%.y ~] + [=(i.filter name) t.filter] +-- +:: +:- %say +|= $: [now=@da eny=@uvJ bec=beak] + [filter=$?($~ [pax=path $~])] + $~ + == +:- %tang +%^ test-runner +?~ filter ~ pax.filter +eny +(test-map-to-test-list:tester all-tests) diff --git a/gen/twit/as.hoon b/gen/twit/as.hoon index 1cfb39bc4..1d48ec8de 100644 --- a/gen/twit/as.hoon +++ b/gen/twit/as.hoon @@ -11,4 +11,4 @@ |= $: {now/@da eny/@uvJ bec/beak} {{who/knot msg/cord $~} $~} == -[%twit-do [who %post eny msg]] +[%twit-do [who %post `@uvI`(rsh 8 1 eny) msg]] diff --git a/gen/twit/feed.hoon b/gen/twit/feed.hoon index a22ce7a00..f3aaf966f 100644 --- a/gen/twit/feed.hoon +++ b/gen/twit/feed.hoon @@ -13,7 +13,7 @@ |= $: {now/@da eny/@uvJ bek/beak} {{who/iden $~} typ/?($user $home)} == -=+ pax=/(scot %p p.bek)/twit/(scot %da now)/[typ]/[who] +=+ pax=/(scot %p p.bek)/twit/(scot %da now)/[typ]/[who]/twit-feed :- %tang %+ turn (flop .^((list post:twitter) %gx pax)) |= post:twitter ^- tank diff --git a/lib/gh-parse.hoon b/lib/gh-parse.hoon index 025dcdbb7..6e07cc323 100644 --- a/lib/gh-parse.hoon +++ b/lib/gh-parse.hoon @@ -79,6 +79,19 @@ 'watchers'^ni 'default_branch'^so == +++ commit + ^- $-(json (unit commit:gh)) + =+ jo + %- ot :~ + 'sha'^so + 'url'^so + 'author'^author + 'committer'^author + 'message'^so + 'tree'^point + 'parents'^(ar point) + 'verification'^verification + == ++ user ^- $-(json (unit user:gh)) =+ jo @@ -128,6 +141,30 @@ 'closed_at'^(mu so) 'body'^so == +++ author + ^- $-(json (unit author:gh)) + =+ jo + %- ot :~ + 'date'^so + 'name'^so + 'email'^so + == +++ point + ^- $-(json (unit point:gh)) + =+ jo + %- ot :~ + 'url'^so + 'sha'^so + == +++ verification + ^- $-(json (unit verification:gh)) + =+ jo + %- ot :~ + 'verified'^bo + 'reason'^so + 'signature'^(mu so) + 'payload'^(mu so) + == ++ label ^- $-(json (unit label:gh)) =+ jo diff --git a/lib/hall-json.hoon b/lib/hall-json.hoon index 78065687c..2bf9a1779 100644 --- a/lib/hall-json.hoon +++ b/lib/hall-json.hoon @@ -29,31 +29,22 @@ ++ de-tape ::> tape to sur (parse) |% ++ circ ::> circle - ;~((glue fas) ;~(pfix sig fed:ag) urt:ab) + ;~((glue fas) ;~(pfix sig fed:ag) urs:ab) :: - ++ rang ::> range - =/ pont - ;~ pose - (stag %ud dim:ag) - %+ stag %da - %+ sear - |= a/coin - ^- (unit @da) - ?. ?=({$$ $da @da} a) ~ - `q.p.a - nuck:so - == - =+ ;~ pose - (cook some ;~(pfix fas pont)) - (easy ~) + ++ pont + ;~ pfix fas + %+ sear + |= a/coin + ^- (unit place) + ?+ a ~ + {$$ $da @da} `p.a + {$$ $ud @ud} `p.a == - ;~ pose - (cook some ;~(plug ;~(pfix fas pont) -)) - (easy ~) + nuck:so == :: - ++ sorc ::> source - ;~(plug circ rang) + ++ sorc + ;~(plug circ (punt ;~(plug pont (punt pont)))) -- :: ++ enjs ::> sur to json @@ -187,6 +178,7 @@ $full (conf cof.a) $source (pairs add+b+add.a src+(sorc src.a) ~) $caption s+cap.a + $usage (pairs add+b+add.a tas+(sa tas.a cord) ~) $filter (filt fit.a) $secure s+sec.a $permit (pairs add+b+add.a sis+(sa sis.a ship) ~) @@ -238,6 +230,7 @@ %- pairs :~ src+(sa src.a sorc) cap+s+cap.a + tag+(sa tag.a cord) fit+(filt fit.a) con+(cont con.a) == @@ -434,6 +427,7 @@ %- of :~ full+conf source+(ot add+bo src+sorc ~) + usage+(ot add+bo tas+(as so) ~) caption+so filter+filt secure+secu @@ -478,6 +472,7 @@ %- ot :~ src+(as sorc) cap+so + tag+(as so) fit+filt con+cont == diff --git a/lib/hall.hoon b/lib/hall.hoon index 69cc0c6d2..ff6d7401e 100644 --- a/lib/hall.hoon +++ b/lib/hall.hoon @@ -44,6 +44,19 @@ ^- {serial _eny.bol} [(shaf %serial eny.bol) (shax eny.bol)] :: +::TODO add to zuse? +++ simple-wrap + |= {txt/tape wyd/@ud} + ^- (list tape) + ?~ txt ~ + =+ ^- {end/@ud nex/?} + ?: (lte (lent txt) wyd) [(lent txt) &] + =+ ace=(find " " (flop (scag +(wyd) `tape`txt))) + ?~ ace [wyd |] + [(sub wyd u.ace) &] + :- (tufa (scag end `(list @)`txt)) + $(txt (slag ?:(nex +(end) end) `tape`txt)) +:: ++ range-to-path :> msg range to path :> @@ -113,6 +126,15 @@ $caption cof(cap cap.dif) $filter cof(fit fit.dif) $remove cof + :: + $usage + %= cof + tag + %. tas.dif + ?: add.dif + ~(uni in tag.cof) + ~(dif in tag.cof) + == :: $source %= cof diff --git a/lib/hood/drum.hoon b/lib/hood/drum.hoon index 217fc547e..a76d84291 100644 --- a/lib/hood/drum.hoon +++ b/lib/hood/drum.hoon @@ -392,8 +392,9 @@ ++ se-show :: show buffer, raw |= lin/(pair @ud stub:dill) ^+ +> + =. p.lin (add p.lin (lent-stye:klr q.lin)) ?: =(mir lin) +> - =. +> ?:(=(p.mir p.lin) +> (se-blit %hop (add p.lin (lent-stye:klr q.lin)))) + =. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin)) =. +> ?:(=(q.mir q.lin) +> (se-blit %pom q.lin)) +>(mir lin) :: @@ -401,13 +402,13 @@ |= {pom/stub:dill lin/(pair @ud (list @c))} ^+ +> =/ pol (lent-char:klr pom) - =/ end (sub edg pol) =/ pos (add pol p.lin) ?: (gte (div (mul pol 100) edg) 35) :: old style (long prompt) - =/ off ?:((lte p.lin end) 0 (sub p.lin end)) + =/ off ?:((lte pos edg) 0 (sub pos edg)) %+ se-show (sub pos off) (swag:klr [off edg] (welp pom [*stye:dill q.lin]~)) + =/ end (sub edg pol) =. off ?: (gth p.lin (add end off)) (sub p.lin end) ?: (lth p.lin off) diff --git a/lib/hood/helm.hoon b/lib/hood/helm.hoon index 9ae46687a..127547184 100644 --- a/lib/hood/helm.hoon +++ b/lib/hood/helm.hoon @@ -2,7 +2,7 @@ :::: /hoon/helm/hood/lib :: :: :: :: :: /? 310 :: version -/- sole +/- sole, hall [. sole] :: :: :: :::: :: :: @@ -60,6 +60,8 @@ $% {$hood-unsync desk ship desk} :: {$ask-mail cord} :: {$helm-hi cord} :: + {$drum-start well:gall} :: + {$hall-action action:hall} :: == :: -- |_ moz/(list move) @@ -238,4 +240,51 @@ ++ take-woot :: result of %want |= {way/wire her/ship cop/coop} =< abet (emit %flog ~ %text "woot: {<[way cop]>}") +:: +++ poke-tlon-init-stream + :: creates stream channel and makes it pull from + :: urbit-meta on {met}. + |= met/ship =< abet + %- emil + %- flop + :~ ^- card + :^ %poke /helm/web/stream/create [our %hall] + :- %hall-action + :- %create + [%stream 'stream relay channel' %channel] + :: + :^ %poke /helm/web/stream/filter [our %hall] + :- %hall-action + :- %filter + [%stream | |] + :: + :^ %poke /helm/web/stream/source [our %hall] + :- %hall-action + :- %source + [%stream & [[[met %urbit-meta] `[da+(sub now ~d1) ~]] ~ ~]] + == +:: +++ poke-tlon-add-fora + :: makes the local urbit-meta pull from {for}'s fora + :: notification channels. + |= for/ship =< abet + %- emil + :~ :^ %poke /helm/web/fora/source [our %hall] + :- %hall-action + :- %source + [%urbit-meta & [[[for %fora-posts] `[da+now ~]] ~ ~]] + :: + :^ %poke /helm/web/fora/source [our %hall] + :- %hall-action + :- %source + [%urbit-meta & [[[for %fora-comments] `[da+now ~]] ~ ~]] + == +:: +++ poke-tlon-add-stream + :: makes the local urbit-meta pull from {web}'s stream. + |= web/ship =< abet + %- emit + :^ %poke /helm/web/stream/source [our %hall] + :+ %hall-action %source + [%urbit-meta & [[[web %stream] `[da+now ~]] ~ ~]] -- diff --git a/lib/hood/kiln.hoon b/lib/hood/kiln.hoon index 1b6d1327d..c6f80ff6a 100644 --- a/lib/hood/kiln.hoon +++ b/lib/hood/kiln.hoon @@ -67,6 +67,7 @@ {$dirk wire @tas} :: {$ogre wire $@(@tas beam)} :: {$merg wire @p @tas @p @tas case germ} :: + {$perm wire ship desk path rite} :: {$poke wire dock pear} :: {$wipe wire @p $~} :: {$wait wire @da} :: @@ -185,6 +186,12 @@ =+ old=;;((map @da cord) (fall (file where) ~)) `(foal where %sched !>((~(put by old) tym eve))) :: +++ poke-permission + |= {syd/desk pax/path pub/?} + =< abet + %^ emit %perm /kiln/permission + [our syd pax %r ~ ?:(pub %black %white) ~] +:: ++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod)) ++ poke-start-autoload |=($~ abet:start:autoload) :: @@ -267,6 +274,11 @@ :: ++ poke-wipe-ford |=($~ abet:(emit %wipe /kiln our ~)) :: +++ mack + |= {way/wire saw/(unit tang)} + ~? ?=(^ saw) [%kiln-nack u.saw] + abet +:: ++ take |=(way/wire ?>(?=({@ $~} way) (work i.way))) :: general handler ++ take-mere :: |= {way/wire are/(each (set path) (pair term tang))} diff --git a/lib/new-hoon.hoon b/lib/new-hoon.hoon new file mode 100644 index 000000000..3354b7b49 --- /dev/null +++ b/lib/new-hoon.hoon @@ -0,0 +1,1557 @@ +:> basic containers +|% +:: +++ first + |* a=^ + -.a +:: +++ second + |* a=^ + +.a +:: +++ either |*([a=mold b=mold] $%({$& p/a} {$| p/b})) :: either +:: +++ thr + |% + ++ apply + :> applies {b} {a} is first, or {b} to {a} is second. + |* [a=(either) b=$-(* *) c=$-(* *)] + ?- -.a + $& (b p.a) + $| (c p.a) + == + :: + ++ firsts + :> returns a list of all first elements in {a}. + |* a=(list (either)) + => .(a (homo a)) + |- + ?~ a + ~ + ?- -.i.a + $& [p.i.a $(a t.a)] + $| $(a t.a) + == + :: + ++ seconds + :> returns a list of all second elements in {a}. + |* a=(list (either)) + => .(a (homo a)) + |- + ?~ a + ~ + ?- -.i.a + $& $(a t.a) + $| [p.i.a $(a t.a)] + == + :: + ++ partition + :> splits the list of eithers into two lists based on first or second. + |* a=(list (either)) + => .(a (homo a)) + |- + ^- {(list _?>(?=({{%& *} *} a) p.i.a)) (list _?>(?=({{%| *} *} a) p.i.a))} + ?~ a + [~ ~] + =+ ret=$(a t.a) + ?- -.i.a + $& [[p.i.a -.ret] +.ret] + $| [-.ret [p.i.a +.ret]] + == + -- +++ maybe |*(a=mold $@($~ {$~ u/a})) :: maybe +++ myb + |% + ++ is-null + :> returns %.y if maybe is null. + :> + :> corresponds to {isJust} in haskell. + |* a=(maybe) + :> whether {a} is null. + ?~ a %.y + %.n + :: + ++ exists + :> returns %.y if maybe contains a real value. + :> + :> corresponds to {isNothing} in haskell. + |* a=(maybe) + :> whether {a} is not null. + ?~ a %.n + %.y + :: + ++ need + :> returns the value or crashes. + :> + :> corresponds to {fromJust} in haskell. + |* a=(maybe) + ?~ a ~>(%mean.[%leaf "need"] !!) + :> the value from the maybe. + u.a + :: + ++ default + :> returns the value in the maybe, or a default value on null. + :> + :> corresponds to {fromMaybe} in haskell. + |* [a=(maybe) b=*] + ?~(a b u.a) + :: + ++ from-list + :> returns the first value of the list, or null on empty list. + :> + :> corresponds to {listToMaybe} in haskell. + |* a=(list) + ^- (maybe _i.a) + ?~ a ~ + [~ i.a] + :: + ++ to-list + :> converts the maybe to a list. + :> + :> corresponds to {maybeToList} in haskell. + |* a=(maybe) + ^- (list _u.a) + ?~ a ~ + [u.a ~] + :: + ++ concat + :> converts a list of maybes to a list of non-null values. + :> + :> corresponds to {catMaybes} in haskell. + |* a=(list (maybe)) + => .(a (homo a)) + |- + ^- (list _u.+.i.-.a) + ?~ a ~ + ?~ i.a + $(a t.a) + [u.i.a $(a t.a)] + :: + ++ map + :> a version of map that can throw out items. + :> + :> takes a list of items and a function of the type + :> + :> todo: while this was in Data.Maybe in haskell, this might better + :> logically be put in our list class? murn is. + :> + :> corresponds to {mapMaybes} in haskell. + |* [a=(list) b=$-(* (maybe))] + => .(a (homo a)) + |- + ^- (list _,.+:*b) + ?~ a ~ + =+ c=(b i.a) + ?~ c + $(a t.a) + :: todo: the span of c does not have the faces of a maybe. how do i either + :: force a resurface or act safely on the incoming? + [+.c $(a t.a)] + :: + ++ apply + :> applies {b} to {a}. + |* [a=(maybe) b=$-(* (maybe))] + ?~ a ~ + (b u.a) + :: + :: todo: bind, bond, both, flit, hunt, lift, mate, + :: + :: used in other files: bond, drop (but only once) + :: unusued: clap + -- +++ ls + :: we are back to a basic problem here: when we try to pass lists without + :: {i} and {t} faces, we have to use {-} and {+} to access the structure of + :: the list. but we then can't deal with incoming lists that do have faces, + :: as `+:[i="one" t=~]` is `t=~`, not `~`. + :: + :: what i really want is that the sapn outside a |* is `{"" 2 "" $~}`, but + :: inside, it is `(list $?(@ud tape))`. all of a sudden, you don't need + :: ++limo or ++homo, because you have the right span from the beginning! + :: those two functions really feel like they're working around the type + :: system instead of cooperating with it. + :: + :> list utilities + |% + :> # %basic + :> basic list manipulation + +| + :: + ++ head + :> returns the first item in the list, which must be non-empty. + |* a=(list) + => .(a (homo a)) + :> the first item in the list. + ?~ a ~>(%mean.[%leaf "head"] !!) + i.a + :: + ++ last + :> returns the final item in the list, which must be non-empty. + |* a=(list) + :> the last item in a list. + ?~ a ~>(%mean.[%leaf "last"] !!) + ?~ t.a + i.a + $(a t.a) + :: + ++ tail + :> returns all items after the head of the list, which must be non-empty. + |* a=(list) + ^+ a + ?~ a ~>(%mean.[%leaf "tail"] !!) + t.a + :: + ++ init + :> returns all items in the list except the last one. must be non-empty. + |* a=(list) + => .(a (homo a)) + |- + ^+ a + ?~ a ~>(%mean.[%leaf "init"] !!) + |- + ?~ t.a + ~ + [i.a $(a t.a)] +:: :: +:: :: ommitted: uncons, null +:: :: + ++ size + :> returns the number of items in {a}. + :> + :> corresponds to {length} in haskell. + |= a=(list) + =| b=@u + ^- @u + |- + ?~ a + b + $(a t.a, b +(b)) + :: + :> # %transformations + :> functions which change a list into another list + +| + :: + ++ map + :> applies a gate to each item in the list. + |* [a=(list) b=$-(* *)] + ^- (list _*b) + ?~ a ~ + [(b i.a) $(a t.a)] + :: + ++ reverse + :> reverses the order of the items in the list. + |* a=(list) + => .(a (homo a)) + ^+ a + =+ b=`_a`~ + |- + ?~ a b + $(a t.a, b [i.a b]) + :: + ++ intersperse + :> places {a} between each element in {b}. + |* [a=* b=(list)] + => .(b (homo b)) + |- + ^+ (homo [a b]) + ?~ b + ~ + =+ c=$(b t.b) + ?~ c + [i.b ~] + [i.b a c] + :: + ++ intercalate + :> places {a} between each list in {b}, and flatten to a single list. + |* [a=(list) b=(list (list))] + => .(a ^.(homo a), b ^.(homo b)) + |- + ^+ (concat [a b]) + ?~ b + ~ + =+ c=$(b t.b) + ?~ c + i.b + :(weld i.b a c) + :: + ++ transpose + :> transposes rows and columns of a 2d list structure. + |* input=(list (list)) + :: todo: this should homogenize with each sublist. + ^- (list (list)) + =/ items + %^ foldl input `{(list) (list (list))}`[~ ~] + |= :> current: the list of first items under construction. + :> remaining: the remaining item lists. + :> next: the next list in {input}. + {state/{current/(list) remaining/(list (list))} next/(list)} + ?~ next + state + ?~ t.next + [[i.next current.state] remaining.state] + [[i.next current.state] [t.next remaining.state]] + ?~ +.items + `(list (list))`[(reverse -.items) ~] + [(reverse -.items) $(input (reverse +.items))] + :: +:: :: ++ subsequences +:: :: |= a=(list) +:: :: ?~ a +:: :: ~ +:: :: :- -.a +:: :: %^ foldr +:: :: $(a +.a) +:: :: `(list)`~ +:: :: |= [ys=(list) r=(list)] +:: :: ~ ::[ys [-.a ys] r ~] +:: :: TODO: +:: :: ++subsequences +:: :: ++permutations + + :: + :> # %folds + :> functions which reduce a list to a value + +| + :: + ++ foldl + :> left associative fold + :> + :> this follows haskell giving an explicit starting value instead of {roll}. + |* [a=(list) b=* c=$-({* *} *)] + ^+ b + ?~ a + b + $(a t.a, b (c b i.a)) + :: + ++ foldr + :> right associative fold + |* [a=(list) b=* c=$-({* *} *)] + ^+ b + ?~ a + b + (c $(a t.a) i.a) + :: + ++ concat + :> concatenate a list of lists into a single level. + |* a=(list (list)) + => .(a ^.(homo a)) + |- ^+ (homo i:-.a) + ?~ a + ~ + (weld (homo i.a) $(a t.a)) + :: + ++ weld + :> combine two lists, possibly of different types. + |* [a=(list) b=(list)] + => .(a ^.(homo a), b ^.(homo b)) + |- ^- (list $?(_i.-.a _i.-.b)) + ?~ a b + [i.a $(a t.a)] + :: + ++ any + :> returns yes if any element satisfies the predicate + |* [a=(list) b=$-(* ?)] + ?~ a + %.n + ?|((b i.a) $(a t.a)) + :: + ++ all + :> returns yes if all elements satisfy the predicate + |* [a=(list) b=$-(* ?)] + ?~ a + %.y + ?&((b i.a) $(a t.a)) + :: + :: haskell has a bunch of methods like sum or maximum which leverage type + :: classes, but I don't think they can be written generically in hoon. + :: + :: + :> # %building + :> functions which build lists + +| + ++ scanl + :> returns a list of successive reduced values from the left. + |* [a=(list) b=* c=$-({* *} *)] + => .(a (homo a)) + |- + ?~ a + [b ~] + [b $(a t.a, b (c b i.a))] + :: + ++ scanl1 + :> a variant of ++scanl that has no starting value. + |* [a=(list) c=$-({* *} *)] + => .(a (homo a)) + |- + ?~ a + ~ + ?~ t.a + ~ + (scanl t.a i.a c) + :: + ++ scanr + :> the right-to-left version of scanl. + |* [a=(list) b=* c=$-({* *} *)] + => .(a (homo a)) + |- + ^- (list _b) + ?~ a + [b ~] + =+ rest=$(a t.a) + ?> ?=(^ rest) + [(c i.a i.rest) rest] + :: + ++ scanr1 + :> a variant of ++scanr that has no starting value. + |* [a=(list) c=$-({* *} *)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?~ t.a + [i.a ~] + =+ rest=$(a t.a) + ?> ?=(^ rest) + [(c i.a i.rest) rest] + :: + ++ map-foldl + :> performs both a ++map and a ++foldl in one pass. + :> + :> corresponds to {mapAccumL} in haskell. + |* [a=(list) b=* c=$-({* *} {* *})] + ^- {_b (list _+:*c)} + ?~ a + [b ~] + =+ d=(c b i.a) + =+ recurse=$(a t.a, b -.d) + [-.recurse [+.d +.recurse]] + :: + ++ map-foldr + :> performs both a ++map and a ++foldr in one pass. + :> + :> corresponds to {mapAccumR} in haskell. + |* [a=(list) b=* c=$-({* *} {* *})] + ^- {_b (list _+:*c)} + ?~ a + [b ~] + =+ recurse=$(a t.a) + =+ d=(c -.recurse i.a) + [-.d [+.d +.recurse]] + :: + ++ unfoldr + :> generates a list from a seed value and a function. + |* [b=* c=$-(* (maybe {* *}))] + |- + ^- (list _b) + =+ current=(c b) + ?~ current + ~ + :: todo: the span of {c} is resurfaced to have a u. this might do funky + :: things with faces. + [-.+.current $(b +.+.current)] + :: + :> # %sublists + :> functions which return a portion of the list + +| + :: + ++ take + :> returns the first {a} elements of {b}. + |* [a=@ b=(list)] + => .(b (homo b)) + |- + ^+ b + ?: =(0 a) + ~ + ?~ b + ~ + [i.b $(a (dec a), b +.b)] + :: + ++ drop + :> returns {b} without the first {a} elements. + |* [a=@ b=(list)] + ?: =(0 a) + b + ?~ b + b + $(a (dec a), b +.b) + :: + ++ split-at + :> returns {b} split into two lists at the {a}th element. + |* [a=@ b=(list)] + => .(b (homo b)) + |- + ^+ [b b] + ?: =(0 a) + [~ b] + ?~ b + [~ b] + =+ d=$(a (dec a), b t.b) + [[i.b -.d] +.d] + :: + ++ take-while + :> returns elements from {a} until {b} returns %.no. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?. (b -.a) + ~ + [i.a $(a t.a)] + :: + ++ drop-while + :> returns elements form {a} once {b} returns %.no. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ?~ a + ~ + ?. (b i.a) + a + $(a t.a) + :: + ++ drop-while-end + :> drops the largest suffix of {a} which matches {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ?~ a + ~ + =+ r=$(a t.a) + ?: ?&(=(r ~) (b i.a)) + ~ + [i.a r] + :: + ++ split-on + :> returns [the longest prefix of {b}, the rest of the list]. + :> + :> corresponds to {span} in haskell. renamed to not conflict with hoon. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + ?. (b i.a) + [~ a] + =+ d=$(a +.a) + [[i.a -.d] +.d] + :: + ++ break + :> like {split-on}, but reverses the return code of {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + ?: (b i.a) + [~ a] + =+ d=$(a t.a) + [[i.a -.d] +.d] + :: + ++ strip-prefix + :> returns a {maybe} of {b} with the prefix {a} removed, or ~ if no match. + |* [a=(list) b=(list)] + ^- (maybe _b) + ?~ a + `b + ?~ b + ~ + $(a +.a, b +.b) + :: + :: todo: ++group + :: + ++ inits + :> returns all initial segments in reverse order. + :> + :> unlike haskell, this does not return the empty list as the first + :> element, as hoon uses null as the list terminator. + |* a=(list) + => .(a (homo a)) + %- flop + |- + ?~ a ~ + [a $(a (init a))] + :: + ++ tails + :> returns all final segments, longest first. + |* a=(list) + => .(a (homo a)) + |- + ?~ a ~ + [a $(a t.a)] + :: + :> # %predicates + :> functions which compare lists + +| + :: + ++ is-prefix-of + :> returns %.y if the first list is a prefix of the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^- ? + ?~ a + %.y + ?~ b + %.n + ?. =(i.a i.b) + %.n + $(a t.a, b t.b) + :: + ++ is-suffix-of + :> returns %.y if the first list is the suffix of the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + ^- ? + :: todo: this is performant in haskell because of laziness but may not be + :: adequate in hoon. + (is-prefix-of (reverse a) (reverse b)) + :: + ++ is-infix-of + :> returns %.y if the first list appears anywhere in the second. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^- ? + ?~ a + %.y + ?~ b + %.n + ?: (is-prefix-of a b) + %.y + $(b t.b) + :: + :: todo: ++is-subsequence-of + :: + :> # %searching + :> finding items in lists + :: + ++ elem + :> does {a} occur in list {b}? + |* [a=* b=(list)] + ?~ b + %.n + ?: =(a i.b) + %.y + $(b t.b) + :: + ++ lookup + :> looks up the key {a} in the association list {b} + |* [a=* b=(list (pair))] + ^- (maybe _+.-.b) + ?~ b + ~ + ?: =(a p.i.b) + [~ q.i.b] + $(b t.b) + :: + ++ find + :> returns the first element of {a} which matches predicate {b}. + |* [a=(list) b=$-(* ?)] + ^- (maybe _-.a) + ?~ a + ~ + ?: (b i.a) + [~ i.a] + $(a t.a) + :: + ++ filter + :> filter all items in {a} which match predicate {b}. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ a + ?~ a + ~ + ?. (b i.a) + [i.a $(a t.a)] + $(a t.a) + :: + ++ partition + :> returns two lists, one whose elements match {b}, the other which doesn't. + |* [a=(list) b=$-(* ?)] + => .(a (homo a)) + |- + ^+ [a a] + ?~ a + [~ ~] + =+ rest=$(a t.a) + ?: (b i.a) + [[i.a -.rest] +.rest] + [-.rest [i.a +.rest]] + :: + :> # %indexing + :> finding indices in lists + +| + :: + ++ elem-index + :> returns {maybe} the first occurrence of {a} occur in list {b}. + =| i=@u + |= [a=* b=(list)] + ^- (maybe @ud) + ?~ b + ~ + ?: =(a i.b) + `i + $(b t.b, i +(i)) + :: + ++ elem-indices + :> returns a list of indices of all occurrences of {a} in {b}. + =| i/@u + |= [a=* b=(list)] + ^- (list @ud) + ?~ b + ~ + ?: =(a i.b) + [i $(b t.b, i +(i))] + $(b t.b, i +(i)) + :: + ++ find-index + :> returns {maybe} the first occurrence which matches {b} in {a}. + =| i=@u + |* [a=(list) b=$-(* ?)] + ^- (maybe @ud) + ?~ a + ~ + ?: (b i.a) + `i + $(a t.a, i +(i)) + :: + ++ find-indices + :> returns a list of indices of all items in {a} which match {b}. + =| i=@u + |* [a=(list) b=$-(* ?)] + ^- (list @ud) + ?~ a + ~ + ?: (b i.a) + [i $(a t.a, i +(i))] + $(a t.a, i +(i)) + :: + ++ zip + :> takes a list of lists, returning a list of each first items. + |* a=(list (list)) + => .(a (multi-homo a)) + |^ ^+ a + ?~ a ~ + ?. valid + ~ + =+ h=heads + ?~ h ~ + [heads $(a tails)] + :: + ++ valid + %+ all a + |= next=(list) + ?~ a %.n + %.y + :: + ++ heads + ^+ (homo i:-.a) + |- + ?~ a ~ + ?~ i.a ~ + [i.i.a $(a t.a)] + :: + ++ tails + ^+ a + |- + ?~ a ~ + ?~ i.a ~ + [t.i.a $(a t.a)] + -- + ++ multi-homo + |* a=(list (list)) + ^+ =< $ + |% +- $ ?:(*? ~ [i=(homo (snag 0 a)) t=$]) + -- + a + :: + :> # %set + :> set operations on lists + +| + ++ unique + :> removes duplicates elements from {a} + :> + :> corresponds to {nub} in haskell. + |* a=(list) + => .(a (homo a)) + =| seen/(list) + ^+ a + |- + ?~ a + ~ + ?: (elem i.a seen) + $(a t.a) + [i.a $(seen [i.a seen], a t.a)] + :: + ++ delete + :> removes the first occurrence of {a} in {b} + |* [a=* b=(list)] + => .(b (homo b)) + ^+ b + |- + ?~ b + ~ + ?: =(a i.b) + t.b + [i.b $(b t.b)] + :: + ++ delete-firsts + :> deletes the first occurrence of each element in {b} from {a}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ a + ?~ a + ~ + ?~ b + a + ?: (elem i.a b) + $(a t.a, b (delete i.a b)) + [i.a $(a t.a)] + :: + ++ union + :> the list union of {a} and {b}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ (weld a b) + ?~ a + b + ?~ b + ~ + [i.a $(a t.a, b (delete i.a b))] + :: + ++ intersect + :> the intersection of {a} and {b}. + |* [a=(list) b=(list)] + => .(a (homo a), b (homo b)) + |- + ^+ a + ?~ a + ~ + ?: (elem i.a b) + [i.a $(a t.a)] + $(a t.a) + :: + :: todo: everything about ++sort and ++sort-on needs more thought. the + :: haskell implementation uses the Ord typeclass to sort things by + :: default. ++sort as is is probably the correct thing to do. + :: + -- +:: +++ dict + :> a dictionary mapping keys of {a} to values of {b}. + :> + :> a dictionary is treap ordered; it builds a treap out of the hashed key + :> values. + |* [a=mold b=mold] + %+ cork (tree (pair a b)) + |= c/(tree (pair a b)) ^+ c + ?.((valid:dct c) ~ c) +:: +++ dct + |% + :> # %query + :> looks up values in the dict. + +| + ++ empty + :> is the dict empty? + |* a=(dict) + ?~ a %.y + %.n + :: + ++ size + :> returns the number of elements in {a}. + |= a=(dict) + ^- @u + ?~ a 0 + :(add 1 $(a l.a) $(a r.a)) + :: + ++ member + :> returns %.y if {b} is a key in {a}. + |= [a=(dict) key=*] + ^- ? + ?~ a %.n + ?|(=(key p.n.a) $(a l.a) $(a r.a)) + :: + ++ get + :> grab value by key. + |* [a=(dict) key=*] + ^- (maybe _?>(?=(^ a) q.n.a)) + :: ^- {$@($~ {$~ u/_?>(?=(^ a) q.n.a)})} + ?~ a + ~ + ?: =(key p.n.a) + `q.n.a + ?: (gor key p.n.a) + $(a l.a) + $(a r.a) + :: +:: :: todo: is ++got the correct interface to have? Haskell has lookup which +:: :: returns a Maybe and a findWithDefault which passes in a default value. +:: ++ got +:: :> todo: move impl here. +:: :> todo: is there a way to make b/_<><>.a ? +:: |* [a=(dict) key=*] +:: (~(got by a) key) + :: + :: todo: skipping several methods which rely on the the Ord typeclass, like + :: lookupLT. + :: + :> # %insertion + +| + ++ put + :> inserts a new key/value pair, replacing the current value if it exists. + :> + :> corresponds to {insert} in haskell. + |* [a=(dict) key=* value=*] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + ?: =(value q.n.a) + a + [[key value] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-with + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWith} in haskell. + |* [a=(dict) key=* value=* fun=$-({* *} *)] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [[key (fun q.n.a value)] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-with-key + :> inserts {key}/{value}, applying {fun} if {key} already exists. + :> + :> corresponds to {insertWithKey} in haskell. + |* [a=(dict) key=* value=* fun=$-({* * *} *)] + |- ^+ a + ?~ a + [[key value] ~ ~] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [[key (fun p.n.a q.n.a value)] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + ++ put-lookup-with-key + :> combines insertion with lookup in one pass. + :> + :> corresponds to {insertLookupWithKey} in haskell. + |* [a=(dict) key=* value=* fun=$-({* * *} *)] + |- ^- {(maybe _value) _a} + ?~ a + [~ [[key value] ~ ~]] + ?: =(key p.n.a) + :: key already exists; use {fun} to resolve. + [`q.n.a [[key (fun p.n.a q.n.a value)] l.a r.a]] + ?: (gor key p.n.a) + =+ rec=$(a l.a) + =+ d=+.rec + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [-.rec [n.a d r.a]] + [-.rec [n.d l.d [n.a r.d r.a]]] + =+ rec=$(a r.a) + =+ d=+.rec + ?> ?=(^ d) + ?: (vor p.n.a p.n.d) + [-.rec [n.a l.a d]] + [-.rec [n.d [n.a l.a l.d] r.d]] + :: + :> # %delete-update + +| + :: + ++ delete + :> deletes entry at {key}. + |* [a=(dict) key=*] + |- ^+ a + ?~ a + ~ + ?. =(key p.n.a) + ?: (gor key p.n.a) + [n.a $(a l.a) r.a] + [n.a l.a $(a r.a)] + (pop-top a) + :: + ++ adjust + :> updates a value at {key} by passing the value to {fun}. + |* [a=(dict) key=* fun=$-(* *)] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + [~ (fun u.value)] + :: + ++ adjust-with-key + :> updates a value at {key} by passing the key/value pair to {fun}. + |* [a=(dict) key=* fun=$-({* *} *)] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + [~ (fun key u.value)] + :: + ++ update + :> adjusts or deletes the value at {key} by {fun}. + |* [a=(dict) key=* fun=$-(* (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + (fun u.value) + :: + ++ update-with-key + :> adjusts or deletes the value at {key} by {fun}. + |* [a=(dict) key=* fun=$-({* *} (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + ^- (maybe _q.+.n.-.a) + ?~ value ~ + (fun key u.value) + :: + :: todo: + :: ++update-lookup-with-key + :: + ++ alter + :> inserts, deletes, or updates a value by {fun}. + |* [a=(dict) key=* fun=$-((maybe *) (maybe *))] + %^ alter-with-key a key + |= [key=_p.-.n.-.a value=(maybe _q.+.n.-.a)] + (fun value) + :: + ++ alter-with-key + :> inserts, deletes, or updates a value by {fun}. + |* [a=(dict) key=* fun=$-({* (maybe *)} (maybe *))] + |- ^+ a + ?~ a + =+ ret=(fun key ~) + ?~ ret + ~ + [[key u.ret] ~ ~] + ?: =(key p.n.a) + =+ ret=(fun key `q.n.a) + ?~ ret + (pop-top a) + ?: =(u.ret q.n.a) + a + [[key u.ret] l.a r.a] + ?: (gor key p.n.a) + =+ d=$(a l.a) + ?~ d + [n.a ~ r.a] + ?: (vor p.n.a p.n.d) + [n.a d r.a] + [n.d l.d [n.a r.d r.a]] + =+ d=$(a r.a) + ?~ d + [n.a l.a ~] + ?: (vor p.n.a p.n.d) + [n.a l.a d] + [n.d [n.a l.a l.d] r.d] + :: + :> # %combine + +| + :: + ++ union + :> returns the union of {a} and {b}, preferring the value from {a} if dupe + |* [a=(dict) b=(dict)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [n.a $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + ++ union-with + :> returns the union of {a} and {b}, running {fun} to resolve duplicates. + |* [a=(dict) b=(dict) fun=$-({* *} *)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [[p.n.a (fun q.n.a q.n.b)] $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + ++ union-with-key + :> returns the union of {a} and {b}, running {fun} to resolve duplicates. + |* [a=(dict) b=(dict) fun=$-({* * *} *)] + |- ^+ a + ?~ b + a + ?~ a + b + ?: (vor p.n.a p.n.b) + ?: =(p.n.b p.n.a) + [[p.n.a (fun p.n.a q.n.a q.n.b)] $(a l.a, b l.b) $(a r.a, b r.b)] + ?: (gor p.n.b p.n.a) + $(a [n.a $(a l.a, b [n.b l.b ~]) r.a], b r.b) + $(a [n.a l.a $(a r.a, b [n.b ~ r.b])], b l.b) + ?: =(p.n.a p.n.b) + [n.b $(b l.b, a l.a) $(b r.b, a r.a)] + ?: (gor p.n.a p.n.b) + $(b [n.b $(b l.b, a [n.a l.a ~]) r.b], a r.a) + $(b [n.b l.b $(b r.b, a [n.a ~ r.a])], a l.a) + :: + :: TODO: this is untested; move it. +:: :: +:: ++ difference +:: :: todo: move real implementation here. +:: :> returns elements in {a} that don't exist in {b}. +:: |* [a=(dict) b=(dict)] +:: (~(dif by a) b) +:: :: +:: :: todo: +:: :: ++difference-with +:: :: ++difference-with-key +:: :: +:: ++ intersection +:: :: todo: move real implementation here. +:: :> returns elements in {a} that exist in {b}. +:: |* [a=(dict) b=(dict)] +:: (~(int by a) b) +:: :: +:: :: todo: +:: :: ++intersection-with +:: :: ++intersection-with-key + :: + :> # %traversal + +| + :: + ++ map + :> applies {fun} to each value in {a}. + |* [a=(dict) fun=$-(* *)] + ^- (dict _p.-.n.-.a fun) + ?~ a + ~ + [[p.n.a (fun q.n.a)] $(a l.a) $(a r.a)] + :: + ++ map-with-key + :> applies {fun} to each value in {a}. + |* [a=(dict) fun=$-({* *} *)] + ^- (dict _p.-.n.-.a _*fun) + ?~ a + ~ + [[p.n.a (fun p.n.a q.n.a)] $(a l.a) $(a r.a)] + :: + ++ map-fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but dicts are treaps. this means there isn't a + :> horizontal ordering, and thus the distinction between left and right + :> folding isn't relevant. your accumulator function will be called in + :> treap order. + :> + :> corresponds to {mapAccum} in haskell. + |* [a=(dict) b=* fun=$-({* *} {* *})] + ^- {_b (dict _p.-.n.-.a _+:*fun)} + ?~ a + [b ~] + =+ d=(fun b q.n.a) + =. q.n.a +.d + =+ e=$(a l.a, b -.d) + =+ f=$(a r.a, b -.e) + [-.f [n.a +.e +.f]] + :: + ++ map-keys + :> applies {fun} to all keys. + :: todo: the haskell version specifies that the "greatest" original key + :: wins in case of duplicates. this is currently unhandled. maybe i just + :: shouldn't have this gate. + |* [a=(dict) fun=$-(* *)] + %- from-list + %+ map:ls (to-list a) + |= item/_n.-.a + [(fun p.item) q.item] + :: + ++ map-keys-with + :> applies {fun} to all keys, creating a new value with {combine} on dupes. + |* [a=(dict) fun=$-(* *) combine=$-({* *} *)] + ^- (dict _*fun _q.+.n.-.a) + =/ new-list + %+ map:ls (to-list a) + |= item/_n.-.a + [(fun p.item) q.item] + %^ foldl:ls new-list + `(dict _*fun _q.+.n.-.a)`~ + |= [m=(dict _*fun _q.+.n.-.a) p=_i.-.new-list] + (put-with m -.p +.p combine) + :: + ++ fold + :> performs a fold on all the values in {a}. + :> + :> lists have an order, but dicts are treaps. this means there isn't a + :> horizontal ordering, and thus the distinction between left and right + :> folding isn't relevant. your accumulator function will be called in + :> treap order. + |* [a=(dict) b=* fun=$-({* *} *)] + ^- _b + ?~ a + b + =+ d=(fun b q.n.a) + =+ e=$(a l.a, b d) + $(a r.a, b e) + :: + ++ fold-with-keys + :> performs a fold on all the values in {a}, passing keys too. + |* [a=(dict) b=* fun=$-({* * *} *)] + ^+ b + ?~ a + b + =+ d=(fun b p.n.a q.n.a) + =+ e=$(a l.a, b d) + $(a r.a, b e) + :: + ++ any + :> returns yes if any element satisfies the predicate + |* [a=(dict) b=$-(* ?)] + ^- ? + ?~ a + %.n + ?|((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ any-with-key + :> returns yes if any element satisfies the predicate + |* [a=(dict) b=$-({* *} ?)] + ^- ? + ?~ a + %.n + ?|((b p.n.a q.n.a) $(a l.a) $(a r.a)) + :: + ++ all + :> returns yes if all elements satisfy the predicate + |* [a=(dict) b=$-(* ?)] + ^- ? + ?~ a + %.y + ?&((b q.n.a) $(a l.a) $(a r.a)) + :: + ++ all-with-key + :> returns yes if all elements satisfy the predicate + |* [a=(dict) b=$-({* *} ?)] + ^- ? + ?~ a + %.y + ?&((b p.n.a q.n.a) $(a l.a) $(a r.a)) + :: + :> # %conversion + +| + ++ elems + :> return all values in the dict. + |* a=(dict) + %+ turn (to-list a) second + :: + ++ keys + :> returns all keys in the dict. + |* a=(dict) + %+ turn (to-list a) first + :: + :: todo: ++assocs probably doesn't make sense when we have ++to-list and + :: when there's no general noun ordering. + :: + ++ keys-set + :> returns all keys as a set. + |* a=(dict) + (si:nl (keys a)) + :: + ++ from-set + :> computes a dict by running {fun} on every value in a set. + |* [a=(set) fun=$-(* *)] + ^- (dict _n.-.a _*fun) + ?~ a + ~ + [[n.a (fun n.a)] $(a l.a) $(a r.a)] + :: + :> # %lists + +| + :: + ++ to-list + :> creates a list of pairs from the tree. + |* a=(dict) + =| b=(list _n.-.a) + |- + ^+ b + ?~ a + b + $(a r.a, b [n.a $(a l.a)]) + :: + ++ from-list + :> creates a tree from a list. + |* a=(list (pair)) + |- + %^ foldl:ls a + `(dict _p.-.i.-.a _q.+.i.-.a)`~ + |= [m=(dict _p.-.i.-.a _q.+.i.-.a) p=_i.-.a] + (put m p) + :: + ++ from-list-with + :> creates a dict from a list, with {fun} resolving duplicates. + |* [a=(list (pair)) fun=$-(* *)] + %^ foldl:ls a + `(dict _*fun _q.+.i.-.a)`~ + |= [m=(dict _*fun _q.+.i.-.a) p=_i.-.a] + (put-with m -.p +.p fun) + :: + :: todo: without a natural ordering, association lists and gates to operate + :: on them probably don't make sense. i'm skipping them for now. + :: + :> # %filters + +| + ++ filter + :> filters a dict of all values that satisfy {fun}. + |* [a=(dict) fun=$-(* ?)] + %+ filter-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ filter-with-key + :> filters a dict of all values that satisfy {fun}. + |* [a=(dict) fun=$-({* *} ?)] + |- + ^+ a + ?~ a ~ + ?: (fun n.a) + =. l.a $(a l.a) + =. r.a $(a r.a) + (pop-top a) + [n.a $(a l.a) $(a r.a)] + :: + ++ restrict-keys + :> returns a dict where the only allowable keys are {keys}. + |* [a=(dict) keys=(set)] + %+ filter-with-key a + |= [key=_p.-.n.-.a value=*] + :: todo: replace this with a call to our set library when we advance that + :: far. + !(~(has in keys) key) + :: + ++ without-keys + :> returns a dict where the only allowable keys are not in {keys}. + |* [a=(dict) keys=(set)] + %+ filter-with-key a + |= [key=_p.-.n.-.a value=*] + :: todo: replace this with a call to our set library when we advance that + :: far. + (~(has in keys) key) + :: + ++ partition + :> returns two lists, one whose elements match {fun}, the other doesn't. + |* [a=(dict) fun=$-(* ?)] + :: todo: is the runtime on this is bogus? + =/ data + %+ partition:ls (to-list a) + |= p/_n.-.a + (fun q.p) + [(from-list -.data) (from-list +.data)] + :: + :: todo: ++partition-with-key once ++partition works. + :: + :: i'm going to ignore all the Antitone functions; they don't seem to be + :: useful without ordering on the dict. + :: + ++ map-maybe + :> a version of map that can throw out items. + |* [a=(dict) fun=$-(* (maybe))] + %+ map-maybe-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ map-maybe-with-key + :> a version of map that can throw out items. + |* [a=(dict) fun=$-({* *} (maybe))] + ^- (dict _p.-.n.-.a _+:*fun) + ?~ a ~ + =+ res=(fun n.a) + ?~ res + =. l.a $(a l.a) + =. r.a $(a r.a) + (pop-top a) + [[p.n.a +.res] $(a l.a) $(a r.a)] + :: + ++ map-either + :> splits the dict in two on a gate that returns an either. + |* [a=(dict) fun=$-(* (either))] + %+ map-either-with-key a + |= [key=* value=_q.+.n.-.a] + (fun value) + :: + ++ map-either-with-key + :> splits the dict in two on a gate that returns an either. + |* [a=(dict) fun=$-({* *} (either))] + |- + ^- $: (dict _p.-.n.-.a _?>(?=({{%& *} *} *fun) +:*fun)) + (dict _p.-.n.-.a _?>(?=({{%| *} *} *fun) +:*fun)) + == + ?~ a + [~ ~] + :: todo: runtime wise, can I do better than recursive unions? + =+ lr=$(a l.a) + =+ rr=$(a r.a) + =+ x=(fun n.a) + ~! x + ?- -.x + $& [(put (union -.lr -.rr) p.n.a +.x) (union +.lr +.rr)] + $| [(union -.lr -.rr) (put (union +.lr +.rr) p.n.a +.x)] + == + :: + :: ++split, ++split-lookup and ++split-root do not make sense without + :: ordinal keys. + :: + ++ is-subdict + :> returns %.y if every element in {a} exists in {b} with the same value. + |* [a=(dict) b=(dict)] + ^- ? + (is-subdict-by a b |=([a=* b=*] =(a b))) + :: + ++ is-subdict-by + :> returns %.y if every element in {a} exists in {b} with the same value. + |* [a=(dict) b=(dict) fun=$-({* *} ?)] + |- + ^- ? + ?~ a %.y + ?~ b %.n + ~! b + ~! p.n.a + =+ x=(get b p.n.a) + ?~ x %.n + |((fun q.n.a u.x) $(a l.a) $(a r.a)) + :: + :> # %impl + :> implementation details + +| + ++ pop-top + :> removes the head of the tree and rebalances the tree below. + |* a=(dict) + ^- {$?($~ _a)} + ?~ a ~ + |- + ?~ l.a r.a + ?~ r.a l.a + ?: (vor p.n.l.a p.n.r.a) + [n.l.a l.l.a $(l.a r.l.a)] + [n.r.a $(r.a l.r.a) r.r.a] + :: + ++ valid + :> returns %.y if {a} if this tree is a valid treap dict. + |* a=(tree (pair * *)) + =| [l=(maybe) r=(maybe)] + |- ^- ? + ?~ a & + ?& ?~(l & (gor p.n.a u.l)) + ?~(r & (gor u.r p.n.a)) + ?~(l.a & ?&((vor p.n.a p.n.l.a) $(a l.a, l `p.n.a))) + ?~(r.a & ?&((vor p.n.a p.n.r.a) $(a r.a, r `p.n.a))) + == + -- +++ random + :> produces a core which produces random numbers. + :> + :> random numbers are generated through repeated sha-256 operations. + :> + :> this design forces implementation details to be hidden, forces users to + :> go through =^. this should be less error prone for pulling out multiple + :> random numbers, at the cost of making getting a single random number + :> slightly more cumbersome. + :> + :> =+ gen=(random eny) + :> =^ first gen (range:gen 0 10) + :> =^ second gen (range:gen 0 10) + |= a=@ + => |% + ++ raw :: random bits + |= b=@ ^- @ + %+ can + 0 + =+ c=(shas %og-a (mix b a)) + |- ^- (list {@ @}) + ?: =(0 b) + ~ + =+ d=(shas %og-b (mix b (mix a c))) + ?: (lth b 256) + [[b (end 0 b d)] ~] + [[256 d] $(c d, b (sub b 256))] + :: + ++ rad :: random in range + |= b=@ ^- @ + =+ c=(raw (met 0 b)) + ?:((lth c b) c $(a +(a))) + -- + ^? |% + ++ range + :> returns a random number in the range [start, end], and generator. + |= [start=@ end=@] + ?: (gte start end) + ~_(leaf+"invalid range" !!) + =+ offset=(sub end start) + =+ r=(rad offset) + [(add start r) +>.$(a (shas %og-s (mix a r)))] + :: + ++ bits + :> returns {b} bits in the range, and generator. + |= b=@ + =+ r=(raw b) + [r +>.$(a (shas %og-s (mix a r)))] + -- +-- diff --git a/lib/oauth1.hoon b/lib/oauth1.hoon index de2714b4a..35a47dc90 100644 --- a/lib/oauth1.hoon +++ b/lib/oauth1.hoon @@ -55,7 +55,7 @@ |= {a/purl b/quay} ^- hiss =. b (quay:hep-to-cab b) =- [a %post - ?~(b ~ (some (as-octt +:(tail:en-purl:html b))))] - (my content-type+['application/x-www-form-en-urlt:htmlncoded']~ ~) + (my content-type+['application/x-www-form-urlencoded']~ ~) :: :: ++ mean-wall !. diff --git a/lib/tester.hoon b/lib/tester.hoon new file mode 100644 index 000000000..16ba5c21c --- /dev/null +++ b/lib/tester.hoon @@ -0,0 +1,165 @@ +/+ new-hoon +:: +:> testing utilities +|% +:> # %models ++| ++= tests + :> a hierarchical structure of tests + :> + :> a recursive association list mapping a part of a path + :> to either a test trap or a sublist of the same type. + (list instance) +:: ++= instance + :> a mapping between a term and part of a test tree. + (pair term (each $-(@uvJ (list tape)) tests)) +:: +:> # %generate +:> utilities for generating ++tests from files and directories. ++| +++ merge-base-and-recur + :> combine the current file and subdirectory. + :> + :> this merges the file {base} with its child files {recur}. + |= [base=vase recur=(map @ta tests:tester)] + ^- tests + =+ a=(gen-tests base) + =+ b=(test-map-to-test-list recur) + :: todo: why does ++weld not work here? {a} and {b} are cast and have the + :: correct faces. + (welp a b) +:: +++ test-map-to-test-list + :> translates ford output to something we can work with. + :> + :> ford gives us a `(map @ta tests:tester)`, but we actually + :> want something like ++tests. + |= a=(map @ta tests:tester) + :: todo: i'd like to sort this, but ++sort has -find.a problems much like + :: ++weld does above!? + ^- tests + %+ turn + (to-list:dct:new-hoon a) + |= {key/@ta value/tests:tester} + [key [%| value]] +:: +++ gen-tests + :> creates a {tests} list out of a vase of a test suite + |= v=vase + ^- tests + =+ arms=(sort (sloe p.v) aor) + %+ turn arms + |= arm/term + :- arm + :- %& + |= eny=@uvJ + =+ context=(slop !>((init-test eny)) v) + =/ r (slap context [%cnsg [arm ~] [%$ 3] [[%$ 2] ~]]) + ((hard (list tape)) q:(slap r [%limb %results])) +:: +:> # %per-test +:> data initialized on a per-test basis. +:: +++ init-test + |= {cookie/@uvJ} + ~(. tester `(list tape)`~ cookie 10 0) +:: +++ tester-type _(init-test `@uvJ`0) +:: +++ tester + |_ $: error-lines=(list tape) :< output messages + eny=@uvJ :< entropy + check-iterations=@u :< # of check trials + current-iteration=@u :< current iteration + == + :> # + :> # %check + :> # + :> gates for quick check style tests. + +| + +- check + |* [generator=$-(@uvJ *) test=$-(* ?)] + |- + ^+ +>.$ + ?: (gth current-iteration check-iterations) + +>.$ + :: todo: wrap generator in mule so it can crash. + =+ sample=(generator eny) + :: todo: wrap test in mule so it can crash. + =+ ret=(test sample) + ?: ret + %= $ + eny (shaf %huh eny) :: xxx: better random? + current-iteration (add current-iteration 1) + == + =+ case=(add 1 current-iteration) + =+ case-plural=?:(=(case 1) "case" "cases") + %= +>.$ + error-lines :* + "falsified after {(noah !>(case))} {case-plural} by '{(noah !>(sample))}'" + error-lines + == + == + :: + :: todo: a generate function that takes an arbitrary span. + :: + ++ generate-range + |= [min=@ max=@] + |= c=@uvJ + ^- @ + =+ gen=(random:new-hoon c) + =^ num gen (range:gen min max) + num + :: + ++ generate-dict + :> generator which will produce a dict with {count} random pairs. + |= count=@u + :> generate a dict with entropy {c}. + |= c=@uvJ + :> + :> gen: stateful random number generator + :> out: resulting map + :> i: loop counter + :> + =/ gen (random:new-hoon c) + =| out=(dict:new-hoon @ud @ud) + =| i=@u + |- + ^- (dict:new-hoon @ud @ud) + ?: =(i count) + out + =^ first gen (range:gen 0 100) + =^ second gen (range:gen 0 100) + $(out (put:dct:new-hoon out first second), i +(i)) + :> # + :> # %test + :> # + :> test expectation functions + +| + :: todo: unit testing libraries have a lot more to them than just eq. + ++ expect-eq + |* [a=* b=* c=tape] + ^+ +> + ?: =(a b) + +>.$ + %= +>.$ + error-lines :* + "failure: '{c}'" + " actual: '{(noah !>(a))}'" + " expected: '{(noah !>(b))}'" + error-lines + == + == + :: + :> # + :> # %output + :> # + :> called by the test harness + :: + ++ results + :> returns results. + ^- (list tape) + error-lines + -- +-- diff --git a/lib/twitter.hoon b/lib/twitter.hoon index 83d71e263..547541584 100644 --- a/lib/twitter.hoon +++ b/lib/twitter.hoon @@ -20,7 +20,7 @@ |= {a/char b/(list @t)} ^- @t %+ rap 3 ?~ b ~ - |-(?~(t.b b [i.b a $(b t.b)])) + |-(?~(t.b b [i.b a $(b t.b)])) :: ++ valve :: produce request |= {med/?($get $post) pax/path quy/quay} @@ -87,9 +87,10 @@ :~ id+ni user+(ot (fasp screen-name+(su user)) ~) (fasp created-at+(cu year (ci stud so))) - text+(cu crip (su (star escp:de-xml))) :: parse html escapes + :: parse html escapes and newlines + text+(cu crip (su (star ;~(pose (just `@`10) escp:de-xml)))) == - ++ usel + ++ usel =, ^?(dejs) %+ ce (list who/@ta) =- (ot users+(ar -) ~) @@ -119,12 +120,12 @@ (valve med (cowl pax +.a b)) :: ++ lutt |=(@u `@t`(rsh 3 2 (scot %ui +<))) - ++ llsc + ++ llsc :: => args:reqs |= a/$@(scr (list scr)) ^- @t ?@(a `@t`a (join ',' a)) :: - ++ llst + ++ llst |= a/$@(@t (list @t)) ^- @t ?@(a `@t`a (join ',' a)) :: @@ -135,7 +136,7 @@ ?@(a (lutt a) (join ',' (turn `(list tid)`a lutt))) :: ++ cowl :: handle parameters - |= $: pax/path + |= $: pax/path ban/(list param) quy/quay == diff --git a/mar/gh/commit.hoon b/mar/gh/commit.hoon new file mode 100644 index 000000000..f64c0eac2 --- /dev/null +++ b/mar/gh/commit.hoon @@ -0,0 +1,11 @@ +/- gh +/+ gh-parse, httr-to-json, old-zuse +=, old-zuse +|_ commit/commit:gh +++ grab + |% + ++ noun commit:gh + ++ httr (cork httr-to-json json) + ++ json commit:gh-parse + -- +-- diff --git a/mar/gh/issue.hoon b/mar/gh/issue.hoon index 84df6402a..5cb3df446 100644 --- a/mar/gh/issue.hoon +++ b/mar/gh/issue.hoon @@ -1,11 +1,13 @@ /- gh -/+ gh-parse, old-zuse +/+ gh-parse, httr-to-json, old-zuse =, mimes:html =, old-zuse |_ issue/issue:gh ++ grab |% ++ noun issue:gh + ++ httr (cork httr-to-json json) + ++ json issue:gh-parse -- ++ grow |% diff --git a/mar/gh/repository.hoon b/mar/gh/repository.hoon new file mode 100644 index 000000000..d8e5d505f --- /dev/null +++ b/mar/gh/repository.hoon @@ -0,0 +1,11 @@ +/- gh +/+ gh-parse, httr-to-json, old-zuse +=, old-zuse +|_ repo/repository:gh +++ grab + |% + ++ noun repository:gh + ++ httr (cork httr-to-json json) + ++ json repository:gh-parse + -- +-- diff --git a/mar/hall/action.hoon b/mar/hall/action.hoon index 24ae2dcab..09381cf86 100644 --- a/mar/hall/action.hoon +++ b/mar/hall/action.hoon @@ -16,11 +16,13 @@ ^- action:hall =- (need ((of -) a)) :~ create+(ot nom+so des+so sec+secu ~) + design+(ot nom+so cof+conf ~) delete+(ot nom+so why+(mu so) ~) depict+(ot nom+so des+so ~) filter+(ot nom+so fit+filt ~) permit+(ot nom+so inv+bo sis+(as (su fed:ag)) ~) source+(ot nom+so sub+bo srs+(as sorc) ~) + usage+(ot nom+so add+bo tas+(as so) ~) :: convey+(ar thot) phrase+(ot aud+audi ses+(ar spec:dejs:hall-json) ~) @@ -46,11 +48,13 @@ %- pairs ?- -.act $create ~[nom+s+nom.act des+s+des.act sec+s+sec.act] + $design ~[nom+s+nom.act cof+(conf cof.act)] $delete ~[nom+s+nom.act why+(mabe why.act cord:enjs)] $depict ~[nom+s+nom.act des+s+des.act] $filter ~[nom+s+nom.act fit+(filt fit.act)] $permit ~[nom+s+nom.act inv+b+inv.act sis+(sa sis.act ship)] $source ~[nom+s+nom.act sub+b+sub.act srs+(sa srs.act sorc)] + $usage ~[nom+s+nom.act add+b+add.act tas+(sa tas.act cord:enjs)] :: $phrase ~[aud+(audi aud.act) ses+a+(turn ses.act spec:enjs)] :: diff --git a/mar/hall/command.hoon b/mar/hall/command.hoon index 3e7106db8..1df81ddba 100644 --- a/mar/hall/command.hoon +++ b/mar/hall/command.hoon @@ -11,5 +11,30 @@ ++ grab :: convert from |% ++ noun command :: from %noun + ++ json :: from %json + => [. dejs:hall-json] ::TODO =, + =, dejs-soft:format + |= a/json + ^- command:hall + =- (need ((of -) a)) + :~ publish+(ar thot) + present+(ot nos+(as so) dif+disa ~) + :: bearing not needed + == + -- +:: +++ grow :: convert to + |% + ++ json :: to %json + => [. enjs:hall-json] ::TODO =, + =, enjs:format + %+ frond -.cod + :: only %publish has just a single piece of data. + ?: ?=($publish -.cod) a+(turn tos.cod thot) + %- pairs + ?+ -.cod !! + $present ~[nos+(sa nos.cod cord:enjs:hall-json) dif+(disa dif.cod)] + :: bearing nto needed + == -- -- diff --git a/mar/unicode-data.hoon b/mar/unicode-data.hoon new file mode 100644 index 000000000..61564ffa7 --- /dev/null +++ b/mar/unicode-data.hoon @@ -0,0 +1,79 @@ +/- 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 sem) + 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 + :: + (flag '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 sem 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 fas hep)) + :: + -- + -- +++ grad %txt +-- diff --git a/ren/test-tree.hoon b/ren/test-tree.hoon new file mode 100644 index 000000000..57d0ec80d --- /dev/null +++ b/ren/test-tree.hoon @@ -0,0 +1,10 @@ +/+ tester +/= base /| /!noun/ + /~ ~ + == +/= recur /^ (map @ta tests:tester) + /| /_ /test-tree/ + /~ ~ + == +:: +(merge-base-and-recur:tester !>(base) recur) diff --git a/sur/gh.hoon b/sur/gh.hoon index d76ee9461..2b7d9299e 100644 --- a/sur/gh.hoon +++ b/sur/gh.hoon @@ -77,6 +77,16 @@ watchers/@ud default-branch/@t == +++ commit + $: sha/@t + url/@t + author/author + committer/author + message/@t + tree/point + parents/(list point) + verification/verification + == ++ user $: login/@t id/id @@ -118,6 +128,21 @@ closed-at/(unit time) body/@t == +++ author + $: date/@t + name/@t + email/@t + == +++ point + $: url/@t + sha/@t + == +++ verification + $: verified/? + reason/@t + signature/(unit @t) + payload/(unit @t) + == ++ label $: url/@t name/@t diff --git a/sur/hall.hoon b/sur/hall.hoon index 6887c3291..3d3bfd995 100644 --- a/sur/hall.hoon +++ b/sur/hall.hoon @@ -7,253 +7,258 @@ ::TODO rename det/delta in most place? they may be (different kinds of) deltas, :: but location in control flow already indicates delta-ness. :: -::> || -::> || %wrappers -::> || -::> wrapper molds, for semantic clarity. -::+| +:> # +:> # %wrappers +:> # +:> wrapper molds, for semantic clarity. ++| :: ::TODO rename -++ naem term ::< circle name -++ nick cord ::< local nickname +++ name term :< circle name +++ nick cord :< local nickname +++ tags (set knot) :< usage tags :: -::> || -::> || %query-models -::> || -::> models relating to queries, their results and updates. -::+| +:> # +:> # %query-models +:> # +:> models relating to queries, their results and updates. ++| :: -++ query ::> query paths - $% {$client $~} ::< shared ui state - {$circles who/ship} ::< readable circles - {$public $~} ::< public memberships - {$burden who/ship} ::TODO eventually, nom/naem. ::< duties to share - {$report $~} ::< duty reports - {$peers nom/naem} ::< readers of story - $: $circle ::> story query - nom/naem ::< circle name - wer/(unit circle) ::< from source - wat/(set circle-data) ::< data to get - ran/range ::< query duration +++ query :> query paths + $% {$client $~} :< shared ui state + {$circles who/ship} :< readable circles + {$public $~} :< public memberships + {$burden who/ship} ::TODO eventually, nom/name. :< duties to share + {$report $~} :< duty reports + {$peers nom/name} :< readers of story + $: $circle :> story query + nom/name :< circle name + wer/(unit circle) :< from source + wat/(set circle-data) :< data to get + ran/range :< query duration == :: ::TODO in the future, we may want much more :: :: detailed querying abilities. :: == :: -++ circle-data ::> kinds of circle data - $? $grams ::< messages - $group-l ::< local presence - $group-r ::< remote presences - $config-l ::< local config - $config-r ::< remote configs +++ circle-data :> kinds of circle data + $? $grams :< messages + $group-l :< local presence + $group-r :< remote presences + $config-l :< local config + $config-r :< remote configs == :: -++ range ::> inclusive msg range - %- unit ::< ~ means everything - $: hed/place ::< start of range - tal/(unit place) ::< opt end of range +++ range :> inclusive msg range + %- unit :< ~ means everything + $: hed/place :< start of range + tal/(unit place) :< opt end of range == :: -++ place ::> range indicators - $% {$da @da} ::< date - {$ud @ud} ::< message number +++ place :> range indicators + $% {$da @da} :< date + {$ud @ud} :< message number == :: -++ prize ::> query result - $% {$client prize-client} ::< /client - {$circles cis/(set naem)} ::< /circles - {$public cis/(set circle)} ::< /public - {$burden sos/(map naem burden)} ::< /burden - {$report $~} ::< /report - {$peers pes/(jar ship query)} ::< /peers - {$circle package} ::< /circle +++ prize :> query result + $% {$client prize-client} :< /client + {$circles cis/(set name)} :< /circles + {$public cis/(set circle)} :< /public + {$burden sos/(map name burden)} :< /burden + {$report $~} :< /report + {$peers pes/(jar ship query)} :< /peers + {$circle package} :< /circle == :: -++ prize-client ::> shared ui state - $: gys/(jug char audience) ::< glyph bindings - nis/(map ship nick) ::< local nicknames +++ prize-client :> shared ui state + $: gys/(jug char audience) :< glyph bindings + nis/(map ship nick) :< local nicknames == :: -++ rumor ::> query result change - $% {$client rum/rumor-client} ::< /client - {$circles add/? cir/naem} ::< /circles - {$public add/? cir/circle} ::< /public - {$burden nom/naem rum/rumor-story} ::< /burden - {$peers add/? who/ship qer/query} ::< /peers - {$circle rum/rumor-story} ::< /circle +++ rumor :> query result change + $% {$client rum/rumor-client} :< /client + {$circles add/? cir/name} :< /circles + {$public add/? cir/circle} :< /public + {$burden nom/name rum/rumor-story} :< /burden + {$peers add/? who/ship qer/query} :< /peers + {$circle rum/rumor-story} :< /circle == :: -++ rumor-client ::> changed ui state - $% {$glyph diff-glyph} ::< un/bound glyph - {$nick diff-nick} ::< changed nickname +++ rumor-client :> changed ui state + $% {$glyph diff-glyph} :< un/bound glyph + {$nick diff-nick} :< changed nickname == :: -++ shipment ::> standard payload - $: cos/lobby ::< loc & rem configs - pes/crowd ::< loc & rem presences +++ shipment :> standard payload + $: cos/lobby :< loc & rem configs + pes/crowd :< loc & rem presences == :: -++ burden ::> full story state - $: gaz/(list telegram) ::< all messages - shipment ::< metadata +++ burden :> full story state + $: gaz/(list telegram) :< all messages + shipment :< metadata == :: -++ package ::> story state - $: nes/(list envelope) ::< messages - shipment ::< metadata +++ package :> story state + $: nes/(list envelope) :< messages + shipment :< metadata == :: -++ diff-glyph {bin/? gyf/char aud/audience} ::< un/bound glyph -++ diff-nick {who/ship nic/nick} ::< changed nickname -++ diff-story ::> story change - $% {$new cof/config} ::< new story - {$bear bur/burden} ::< new inherited story - {$peer add/? who/ship qer/query} ::< gain/lose subscriber - {$config cir/circle dif/diff-config} ::< new/changed config - {$status cir/circle who/ship dif/diff-status} ::< new/changed status - {$remove $~} ::< removed story +++ diff-glyph {bin/? gyf/char aud/audience} :< un/bound glyph +++ diff-nick {who/ship nic/nick} :< changed nickname +++ diff-story :> story change + $% {$new cof/config} :< new story + {$bear bur/burden} :< new inherited story + {$peer add/? who/ship qer/query} :< gain/lose subscriber + {$config cir/circle dif/diff-config} :< new/changed config + {$status cir/circle who/ship dif/diff-status} :< new/changed status + {$remove $~} :< removed story == :: -++ rumor-story ::> story rumor - $? diff-story ::< both in & outward - $% {$gram src/circle nev/envelope} ::< new/changed message +++ rumor-story :> story rumor + $? diff-story :< both in & outward + $% {$gram src/circle nev/envelope} :< new/changed message == == :: -++ diff-config ::> config change - $% {$full cof/config} ::< set w/o side-effects - {$source add/? src/source} ::< add/rem sources - {$caption cap/cord} ::< changed description - {$filter fit/filter} ::< changed filter - {$secure sec/security} ::< changed security - {$permit add/? sis/(set ship)} ::< add/rem to b/w-list - {$remove $~} ::< removed config +++ diff-config :> config change + $% {$full cof/config} :< set w/o side-effects + {$source add/? src/source} :< add/rem sources + {$caption cap/cord} :< changed description + {$usage add/? tas/tags} :< add/rem usage tags + {$filter fit/filter} :< changed filter + {$secure sec/security} :< changed security + {$permit add/? sis/(set ship)} :< add/rem to b/w-list + {$remove $~} :< removed config == :: -++ diff-status ::> status change - $% {$full sat/status} ::< fully changed status - {$presence pec/presence} ::< changed presence - {$human dif/diff-human} ::< changed name - {$remove $~} ::< removed status +++ diff-status :> status change + $% {$full sat/status} :< fully changed status + {$presence pec/presence} :< changed presence + {$human dif/diff-human} :< changed name + {$remove $~} :< removed status == :: -++ diff-human ::> name change - $% {$full man/human} ::< fully changed name - {$handle han/(unit cord)} ::< changed handle - {$true tru/(unit truename)} ::< changed true name +++ diff-human :> name change + $% {$full man/human} :< fully changed name + {$handle han/(unit cord)} :< changed handle + {$true tru/(unit truename)} :< changed true name == :: :: -::> || -::> || %client-communication -::> || -::> hall interfaces for clients. -::+| +:> # +:> # %client-communication +:> # +:> hall interfaces for clients. ++| :: -++ action ::> user action +++ action :> user action $% :: circle configuration :: - {$create nom/naem des/cord sec/security} ::< create circle - {$delete nom/naem why/(unit cord)} ::< delete + announce - {$depict nom/naem des/cord} ::< change description - {$filter nom/naem fit/filter} ::< change message rules - {$permit nom/naem inv/? sis/(set ship)} ::< invite/banish - {$source nom/naem sub/? srs/(set source)} ::< un/sub to/from src + {$create nom/name des/cord sec/security} :< create circle + {$design nom/name cof/config} :< create with config + {$delete nom/name why/(unit cord)} :< delete + announce + {$depict nom/name des/cord} :< change description + {$filter nom/name fit/filter} :< change message rules + {$permit nom/name inv/? sis/(set ship)} :< invite/banish + {$source nom/name sub/? srs/(set source)} :< un/sub to/from src + {$usage nom/name add/? tas/tags} :< add/rem usage tags :: messaging :: - {$convey tos/(list thought)} ::< post exact - {$phrase aud/audience ses/(list speech)} ::< post easy + {$convey tos/(list thought)} :< post exact + {$phrase aud/audience ses/(list speech)} :< post easy :: personal metadata :: - {$notify aud/audience pes/(unit presence)} ::< our presence update - {$naming aud/audience man/human} ::< our name update + {$notify aud/audience pes/(unit presence)} :< our presence update + {$naming aud/audience man/human} :< our name update :: changing shared ui :: - {$glyph gyf/char aud/audience bin/?} ::< un/bind a glyph - {$nick who/ship nic/nick} ::< new identity + {$glyph gyf/char aud/audience bin/?} :< un/bind a glyph + {$nick who/ship nic/nick} :< new identity :: misc changes :: - {$public add/? cir/circle} ::< show/hide membership + {$public add/? cir/circle} :< show/hide membership == :: :: -::> || -::> || %hall-communication -::> || -::> structures for communicating between halls. -::+| +:> # +:> # %hall-communication +:> # +:> structures for communicating between halls. ++| :: -++ command ::> effect on story - $% {$publish tos/(list thought)} ::< deliver - {$present nos/(set naem) dif/diff-status} ::< status update - {$bearing $~} ::< prompt to listen +++ command :> effect on story + $% {$publish tos/(list thought)} :< deliver + {$present nos/(set name) dif/diff-status} :< status update + {$bearing $~} :< prompt to listen == :: :: -::> || -::> || %circles -::> || -::> messaging targets and their metadata. -::+| +:> # +:> # %circles +:> # +:> messaging targets and their metadata. ++| :: -++ circle {hos/ship nom/naem} ::< native target +++ circle {hos/ship nom/name} :< native target :: circle configurations. :: -++ lobby {loc/config rem/(map circle config)} ::< our & srcs configs -++ config ::> circle config - $: src/(set source) ::< active sources - cap/cord ::< description - fit/filter ::< message rules - con/control ::< restrictions +++ lobby {loc/config rem/(map circle config)} :< our & srcs configs +++ config :> circle config + $: src/(set source) :< active sources + cap/cord :< description + tag/tags :< usage tags + fit/filter :< message rules + con/control :< restrictions == :: -++ source {cir/circle ran/range} ::< subscription target -++ filter ::> content filters - $: cas/? ::< dis/allow capitals - utf/? ::< dis/allow non-ascii +++ source {cir/circle ran/range} :< subscription target +++ filter :> content filters + $: cas/? :< dis/allow capitals + utf/? :< dis/allow non-ascii ::TODO maybe message length == :: -++ control {sec/security sis/(set ship)} ::< access control -++ security ::> security mode - $? $channel ::< blacklist - $village ::< whitelist - $journal ::< pub r, whitelist w - $mailbox ::< our r, blacklist w +++ control {sec/security sis/(set ship)} :< access control +++ security :> security mode + $? $channel :< blacklist + $village :< whitelist + $journal :< pub r, whitelist w + $mailbox :< our r, blacklist w == :: :: participant metadata. :: -++ crowd {loc/group rem/(map circle group)} ::< our & srcs presences -++ group (map ship status) ::< presence map -++ status {pec/presence man/human} ::< participant -++ presence ::> status type - $? $gone ::< absent - $idle ::< idle - $hear ::< present - $talk ::< typing +++ crowd {loc/group rem/(map circle group)} :< our & srcs presences +++ group (map ship status) :< presence map +++ status {pec/presence man/human} :< participant +++ presence :> status type + $? $gone :< absent + $idle :< idle + $hear :< present + $talk :< typing == :: -++ human ::> human identifier - $: han/(unit cord) ::< handle - tru/(unit truename) ::< true name +++ human :> human identifier + $: han/(unit cord) :< handle + tru/(unit truename) :< true name == :: -++ truename {fir/cord mid/(unit cord) las/cord} ::< real-life name +++ truename {fir/cord mid/(unit cord) las/cord} :< real-life name :: -::> || -::> || %message-data -::> || -::> structures for containing main message data. -::+| +:> # +:> # %message-data +:> # +:> structures for containing main message data. ++| :: ::TODO some structure for extra message state :: local (to clients): delivery state, read flags :: remote (to halls): sequence nr -++ envelope {num/@ud gam/telegram} ::< outward message -++ telegram {aut/ship thought} ::< whose message -++ thought ::> inner message - $: uid/serial ::< unique identifier - aud/audience ::< destinations - wen/@da ::< timestamp - sep/speech ::< content +++ envelope {num/@ud gam/telegram} :< outward message +++ telegram {aut/ship thought} :< whose message +++ thought :> inner message + $: uid/serial :< unique identifier + aud/audience :< destinations + wen/@da :< timestamp + sep/speech :< content == :: -++ speech ::> content body - $% {$lin pat/? msg/cord} ::< no/@ text line - {$url url/purf:eyre} ::< parsed url - {$exp exp/cord res/(list tank)} ::< hoon line - {$ire top/serial sep/speech} ::< in reply to - {$fat tac/attache sep/speech} ::< attachment - {$app app/term sep/speech} ::< app message - {$inv inv/? cir/circle} ::< inv/ban for circle +++ speech :> content body + $% {$lin pat/? msg/cord} :< no/@ text line + {$url url/purf:eyre} :< parsed url + {$exp exp/cord res/(list tank)} :< hoon line + {$ire top/serial sep/speech} :< in reply to + {$fat tac/attache sep/speech} :< attachment + {$app app/term sep/speech} :< app message + {$inv inv/? cir/circle} :< inv/ban for circle == :: -++ attache ::> attachment - $% {$name nom/cord tac/attache} ::< named attachment - {$text (list cord)} ::< text lines - {$tank (list tank)} ::< tank list +++ attache :> attachment + $% {$name nom/cord tac/attache} :< named attachment + {$text (list cord)} :< text lines + {$tank (list tank)} :< tank list == :: :: -::> || -::> || %message-metadata -::> || -:: structures for containing message metadata. -::+| +:> # +:> # %message-metadata +:> # +:> structures for containing message metadata. ++| :: -++ serial @uvH ::< unique identifier -++ audience (set circle) ::< destinations -++ tracking (map circle delivery) ::> delivery per target -++ delivery ::> delivery state - $? $pending ::< undelivered - $accepted ::< received - $rejected ::< denied +++ serial @uvH :< unique identifier +++ audience (set circle) :< destinations +++ tracking (map circle delivery) :> delivery per target +++ delivery :> delivery state + $? $pending :< undelivered + $accepted :< received + $rejected :< denied == :: -- diff --git a/sur/unicode-data.hoon b/sur/unicode-data.hoon new file mode 100644 index 000000000..a333455c8 --- /dev/null +++ b/sur/unicode-data.hoon @@ -0,0 +1,150 @@ +|% +:> # %unicode-data +:> types to represent UnicdoeData.txt. ++| +++ 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-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) +-- diff --git a/sys/hoon.hoon b/sys/hoon.hoon index 4c7f7b24b..719d6c2c2 100644 --- a/sys/hoon.hoon +++ b/sys/hoon.hoon @@ -273,8 +273,11 @@ ++ mold :> normalizing gate :> - :> actually a type alias for gate. - gate + :> a gate that accepts any noun, and validates its shape, producing the + :> input if it fits or a default value if it doesn't. + :> + :> examples: * @ud ,[p=time q=?(%a %b)] + _|=(* +<) :: ++ pair :> dual tuple @@ -384,7 +387,7 @@ (b u.a) :: ++ bind :: argue - |* {a/(unit) b/$-(* *)} + |* {a/(unit) b/gate} ?~ a ~ [~ u=(b u.a)] :: @@ -658,7 +661,7 @@ :: ++ turn :: transform ~/ %turn - |* {a/(list) b/$-(* *)} + |* {a/(list) b/gate} |- ?~ a ~ [i=(b i.a) t=$(a t.a)] @@ -1469,7 +1472,7 @@ $(a r.a, +<+.b $(a l.a, +<+.b (b n.a +<+.b))) :: +- rib :: transform + product - |* {b/* c/$-(* *)} + |* {b/* c/gate} |- ^+ [b a] ?~ a [b ~] =+ d=(c n.a b) @@ -1479,7 +1482,7 @@ [-.f [n.a +.e +.f]] :: +- run :: apply gate to values - |* b/$-(* *) + |* b/gate |- ?~ a a [n=[p=p.n.a q=(b q.n.a)] l=$(a l.a) r=$(a r.a)] @@ -1761,7 +1764,7 @@ :::: 2n: functional hacks :: :: :: :: -++ aftr |*(a/$-(* *) |*(b/$-(* *) (pair b a))) :: pair after +++ aftr |*(a/gate |*(b/gate (pair b a))) :: pair after ++ cork |*({a/_|=(* **) b/gate} (corl b a)) :: compose forward ++ corl :: compose backwards |* {a/gate b/_|=(* **)} @@ -1779,9 +1782,9 @@ |* b/_+<+.a (a b c) :: -++ fore |*(a/$-(* *) |*(b/$-(* *) (pair a b))) :: pair before +++ fore |*(a/gate |*(b/gate (pair a b))) :: pair before ++ hard :: force remold - |* han/$-(* *) + |* han/gate |= fud/* ^- han ~_ leaf+"hard" =+ gol=(han fud) @@ -1791,7 +1794,7 @@ ++ head |*(^ ,:+<-) :: get head ++ same |*(* +<) :: identity ++ soft :: maybe remold - |* han/$-(* *) + |* han/gate |= fud/* ^- (unit han) =+ gol=(han fud) ?.(=(gol fud) ~ [~ gol]) @@ -2223,7 +2226,7 @@ =+ ^= q %+ max ?: (gth m prc) (^sub m prc) 0 :: reduce precision %- abs:si ?: =(den %i) --0 :: enforce min. exp - ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 + ?: =((cmp:si e.a emn) -1) (dif:si emn e.a) --0 =^ b a :- (end 0 q a.a) a(e (sum:si e.a (sun:si q)), a (rsh 0 q a.a)) :: @@ -3624,7 +3627,7 @@ ++ dime {p/@ta q/@} :: ++ edge {p/hair q/(unit {p/* q/nail})} :: parsing output ++ hair {p/@ud q/@ud} :: parsing trace -++ like |* a/$-(* *) :: generic edge +++ like |* a/gate :: generic edge |= b/_`*`[(hair) ~] :: :- p=(hair -.b) :: ^= q :: @@ -4407,7 +4410,7 @@ :: ++ cook :: apply gate ~/ %cook - |* {poq/$-(* *) sef/rule} + |* {poq/gate sef/rule} ~/ %fun |= tub/nail =+ vex=(sef tub) @@ -9446,7 +9449,7 @@ {$cell *} | {$core *} dext(ref repo(sut ref)) {$face *} dext(ref q.ref) - {$fork *} (levy ~(tap in p.ref) |=(type sint(ref +<))) + {$fork *} (levy ~(tap in p.ref) |=(type dext(ref +<))) {$help *} dext(ref q.ref) {$hold *} ?: (~(has in reg) ref) & ?: (~(has in gil) [sut ref]) & @@ -9904,14 +9907,20 @@ -- |_ 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)] + |= {mil/tape lim/char lam/tape} + ^- tape + =/ esc (~(gas in *(set @tD)) lam) + :- lim + |- ^- tape + ?~ mil [lim ~] + ?: ?| =(lim i.mil) + =('\\' i.mil) + (~(has in esc) 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 @@ -10043,7 +10052,7 @@ [(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)] :: $yarn - [~ %leaf (dash (tape lum) '"')] + [~ %leaf (dash (tape lum) '"' "\{")] :: $void ~ @@ -10056,7 +10065,7 @@ ?+ (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) '\'') + $t (dash (rip 3 lum) '\'' ~) $tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])] == :: @@ -12648,7 +12657,7 @@ == :: ++ desk @tas :: ship desk case spur ++ cage (cask vase) :: global metadata -++ cask |*(a/$-(* *) (pair mark a)) :: global data +++ cask |*(a/mold (pair mark a)) :: global data ++ cuff :: permissions $: p/(unit (set monk)) :: can be read by q/(set monk) :: caused or created by @@ -12656,8 +12665,8 @@ ++ curd {p/@tas q/*} :: typeless card ++ dock (pair @p term) :: message target ++ duct (list wire) :: causal history -++ hypo |*(a/$-(* *) (pair type a)) :: type associated -++ hobo |* a/$-(* *) :: task wrapper +++ hypo |*(a/mold (pair type a)) :: type associated +++ hobo |* a/gate :: task wrapper $? $% {$soft p/*} :: == :: a :: @@ -12713,7 +12722,7 @@ mev/type :: -:!>([%meta *vase]) == :: ++ wind :: new kernel action - |* {a/$-(* *) b/$-(* *)} :: forward+reverse + |* {a/gate b/gate} :: forward+reverse $% {$pass p/path q/a} :: advance {$slip p/a} :: lateral {$give p/b} :: retreat diff --git a/sys/vane/ames.hoon b/sys/vane/ames.hoon index ef74aa235..f90a9d0eb 100644 --- a/sys/vane/ames.hoon +++ b/sys/vane/ames.hoon @@ -1,9 +1,10 @@ -:: :: ames (4a), networking +:: :: ames (4a), networking :: |= pit=vase => =~ :: structures =, ames +=+ protocol-version=0 |% += move [p=duct q=(wind note:able gift:able)] :: local move -- @@ -159,25 +160,25 @@ 0w0 :: 42, ~tul, Curtis Yarvin 0w0 :: 43, ~met, Curtis Yarvin 0w0 :: 44, ~wen, Curtis Yarvin - 0w0 :: 45, ~byn, Curtis Yarvin + 0w0 :: 45, ~byn, Curtis Yarvin 0w0 :: 46, ~hex, James Torre 0w0 :: 47, ~feb, urbit.org 0wK.GoKEY.rMjfn.ZcvFQ.n4BmX :: 48, ~pyl, Michael Hartl (oldkey) - 0w0 :: 49, ~dul, Curtis Yarvin - 0w0 :: 50, ~het, Curtis Yarvin + 0w0 :: 49, ~dul, Galen Wolfe-Pauly + 0w0 :: 50, ~het, Galen Wolfe-Pauly 0w0 :: 51, ~mev, Curtis Yarvin 0w0 :: 52, ~rut, Curtis Yarvin 0w2L.M6-o5.DDTFL.R4sFL.7Zuay :: 53, ~tyl, Tlon Investor 11 (oldkey) 0w0 :: 54, ~wyd, Curtis Yarvin 0w0 :: 55, ~tep, Curtis Yarvin 0w0 :: 56, ~bes, Curtis Yarvin - 0w0 :: 57, ~dex, Jared Hance + 0w0 :: 57, ~dex, Jared Hance 0w0 :: 58, ~sef, Owen Rescher 0w0 :: 59, ~wyc, Galen Wolfe-Pauly 0w0 :: 60, ~bur, Galen Wolfe-Pauly 0w0 :: 61, ~der, Galen Wolfe-Pauly 0w0 :: 62, ~nep, Galen Wolfe-Pauly - 0w0 :: 63, ~pur, Curtis Yarvin + 0w0 :: 63, ~pur, Paul Driver 0w30.VtXvV.S~xIV.iMCL~.j9zTC :: 64, ~rys, Charlie Cummings (oldkey) 0w0 :: 65, ~reb, Curtis Yarvin 0wp.LslIa.IFSM9.mIp-z.KBIBh :: 66, ~den, Michael Hartl (oldkey) @@ -267,7 +268,7 @@ 0w2g.gLmg4.MtrHQ.A5VmH.WPk6G :: 150, ~ryg, Dan Haffey (oldkey) 0w0 :: 151, ~ryx, Tlon 0w0 :: 152, ~fep, Tlon - 0w2j.T1u2s.BfXjV.ldOGR.aiZrQ :: 153, ~tyr, Steve Dee (oldkey) + 0w3x.y5stk.FMmvV.LQo3X.OCXkI :: 153, ~tyr, Steven Dee 0w0 :: 154, ~tus, Tlon 0w0 :: 155, ~tyc, Tlon 0w0 :: 156, ~leg, Tlon @@ -385,7 +386,7 @@ vix=(bex +((cut 0 [25 2] mag))) :: width of sender tay=(cut 0 [27 5] mag) :: message type == - ?> =(7 vez) + ?> =(protocol-version vez) ?> =(chk (end 0 20 (mug bod))) :+ [(end 3 wix bod) (cut 3 [wix vix] bod)] (kins tay) @@ -405,7 +406,7 @@ =+ tay=(ksin q.kec) %+ mix %+ can 0 - :~ [3 7] + :~ [3 protocol-version] [20 (mug bod)] [2 yax] [2 qax] @@ -975,10 +976,10 @@ |= [our=ship ger=@uw fak=?] :: instantiate emperor ^- [p=(list boon) q=fort] =+ ^= loy - ?: fak + ?: fak :: fake uses carrier number as seed :: - (pit:nu:crub:crypto 512 our) + (pit:nu:crub:crypto 512 our) (pit:nu:crub:crypto 512 ger) =+ fim==(fig:ex:loy (zeno our)) ?: &(!fak !fim) !! :: not fake & bad fig @@ -995,7 +996,7 @@ ++ gnaw :: gnaw:am |= [kay=cape ryn=lane pac=rock] :: process packet ^- [p=(list boon) q=fort] - ?. =(7 (end 0 3 pac)) [~ fox] + ?. =(protocol-version (end 0 3 pac)) [~ fox] =+ kec=(bite pac) ?: (goop p.p.kec) [~ fox] ?. (~(has by urb.ton.fox) q.p.kec) @@ -1114,7 +1115,7 @@ :: it now, since it obviously won't be processed. :: ~& [%fail-ack did.rum] - =^ gud +>.$ + =^ gud +>.$ (cook ``[%dead-message ~] cha `[q.u.cun r.u.cun]) ?. gud +>.$ %= +>.$ @@ -1275,15 +1276,15 @@ :: or negative ack if this ship is blocked :: =* cop ^- coop - %+ fall - (~(get by bum.rum) num) + %+ fall + (~(get by bum.rum) num) ?:(bad ~ ``[%blocked ~]) con:(cook (~(get by bum.rum) num) cha `[ryn dam]) :: :: insert this message in unprocessed set :: =. mis.rum (~(put by mis.rum) num [kay ryn dam dut]) - :: + :: :: if ship is blocked, advance pointer to latest message :: =. did.rum ?.(bad did.rum num) @@ -1552,7 +1553,7 @@ (hunt lth doz rtn.sop.bah) :: ++ load - |= old=fort + |= old=fort ~& %ames-reload ..^$(fox old) :: @@ -1599,7 +1600,7 @@ == :: %cake - ~? ?=(^ r.bon) [%cake-woot-bad hen r.bon] + :: ~? ?=(^ r.bon) [%cake-woot-bad hen r.bon] :_ fox :~ [s.bon %give %woot q.p.bon r.bon] == @@ -1613,7 +1614,7 @@ :_ fox [hen %pass pax i.q.q.bon %west p.bon t.q.q.bon r.bon]~ :: %ouzo - :: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))] + :: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))] :_ fox [[gad.fox [%give %send p.bon q.bon]] ~] :: @@ -1683,7 +1684,7 @@ ?: ?=(%wegh -.kyz) ~& %ames-weighing [[hen %give %mass wegh]~ +>] - =+ ^= fuy + =+ ^= fuy ^- [p=(list boon) q=fort] ?- -.kyz %barn diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 95a250fd0..28dc73640 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -44,30 +44,32 @@ :: :: Type of request. :: -:: %d produces a set of desks, %u checks for existence, %v produces a ++dome of -:: all desk data, %w gets a revision number/date, %x gets file contents, -:: %y gets a directory listing, and %z gets a recursive hash of the file -:: contents and children. +:: %d produces a set of desks, %p gets file permissions, %u checks for +:: existence, %v produces a ++dome of all desk data, %w gets a revision +:: number/date, %x gets file contents, %y gets a directory listing, and %z gets +:: a recursive hash of the file contents and children. :: -:: ++ care ?($d $u $v $w $x $y $z) +:: ++ care ?($d $p $u $v $w $x $y $z) :: :: Keeps track of subscribers. :: :: A map of requests to a set of all the subscribers who should be notified :: when the request is filled/updated. :: -++ cult (jug rove duct) +++ cult (jug wove duct) :: :: Domestic desk state. :: :: Includes subscriber list, dome (desk content), possible commit state (for -:: local changes), and possible merge state (for incoming merges). +:: local changes), possible merge state (for incoming merges), and permissions. :: ++ dojo $: qyx/cult :: subscribers dom/dome :: desk state dok/(unit dork) :: commit state mer/(unit mery) :: merge state + per/regs :: read perms per path + pew/regs :: write perms per path == :: :: Desk state. @@ -161,10 +163,6 @@ gon/(each (set path) (pair term (list tank))) :: return value == :: :: -:: Like a ++mood, except with a cache of the state at the starting version. -:: -++ moot {p/case q/case r/path s/(map path lobe)} :: stored change range -:: :: New desk data. :: :: Sent to other ships to update them about a particular desk. Includes a map @@ -187,6 +185,7 @@ :: -- `mon` is a collection of mount points (mount point name to urbit :: location). :: -- `hez` is the unix duct that %ergo's should be sent to. +:: -- `cez` is a collection of named permission groups. :: ++ raft :: filesystem $: fat/(map ship room) :: domestic @@ -194,6 +193,7 @@ ran/rang :: hashes mon/(map term beam) :: mount points hez/(unit duct) :: sync duct + cez/(map @ta crew) :: permission groups == :: :: :: Object store. @@ -242,6 +242,8 @@ dom/dome :: revision state dok/(unit dork) :: outstanding diffs mer/(unit mery) :: outstanding merges + per/regs :: read perms per path + pew/regs :: write perms per path == :: :: :: Foreign request manager. @@ -274,10 +276,18 @@ :: Like a ++rave but with caches of current versions for %next and %many. :: Generally used when we store a request in our state somewhere. :: +++ cach (unit (unit (each cage lobe))) :: cached result +++ wove {p/(unit ship) q/rove} :: stored source + req ++ rove :: stored request $% {$sing p/mood} :: single request - {$next p/mood q/(unit (each cage lobe))} :: next version - {$many p/? q/moot} :: change range + {$next p/mood q/cach} :: next version + $: $mult :: next version of any + p/mool :: original request + q/(unit aeon) :: checking for change + r/(map (pair care path) cach) :: old version + s/(map (pair care path) cach) :: new version + == :: + {$many p/? q/moat r/(map path lobe)} :: change range == :: :: :: Foreign desk data. @@ -312,17 +322,6 @@ -- => |% ++ move {p/duct q/(wind note gift:able)} :: local move -++ gift :: out result <-$ - $% {$dirk p/@tas} :: mark mount dirty - {$ergo p/@tas q/mode} :: version update - {$hill p/(list @tas)} :: mount points - {$mack p/(unit tang)} :: ack - {$mass p/mass} :: memory usage - {$mere p/(each (set path) (pair term tang))} :: merge result - {$note p/@tD q/tank} :: debug message - {$ogre p/@tas} :: delete mount point - {$writ p/riot} :: response - == :: ++ note :: out request $-> $% $: $a :: to %ames $% {$want p/sock q/path r/*} :: @@ -331,6 +330,7 @@ $% {$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} :: == == :: $: $d :: $% {$flog p/{$crud p/@tas q/(list tank)}} :: to %dill @@ -354,7 +354,7 @@ {$writ p/riot} :: == == :: $: $f :: - $% {$made p/@uvH q/gage:ford} :: + $% {$made p/@uvH q/gage:ford} :: == == :: $: $t :: $% {$wake $~} :: timer activate @@ -429,6 +429,8 @@ dom=*dome dok=~ mer=~ + per=~ + pew=~ == :- `hun.u.rom =+ jod=(fall (~(get by dos.u.rom) syd) *dojo) @@ -438,6 +440,8 @@ dom=dom.jod dok=dok.jod mer=mer.jod + per=per.jod + pew=pew.jod == =* red -> =| mow/(list move) @@ -448,21 +452,21 @@ ?~ rom =+ rug=(~(put by rus:(fall (~(get by hoy.ruf) her) *rung)) syd red) ruf(hoy (~(put by hoy.ruf) her rug)) - =+ dos=(~(put by dos.u.rom) syd [qyx dom dok mer]) + =+ 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) :: :: Handle `%sing` requests :: ++ aver - |= mun/mood + |= {for/(unit ship) mun/mood} ^- (unit (unit (each cage lobe))) =+ ezy=?~(ref ~ (~(get by haw.u.ref) mun)) ?^ ezy `(bind u.ezy |=(a/cage [%& a])) =+ nao=(case-to-aeon:ze q.mun) :: ~& [%aver-mun nao [%from syd lim q.mun]] - ?~(nao ~ (read-at-aeon:ze u.nao mun)) + ?~(nao ~ (read-at-aeon:ze for u.nao mun)) :: ++ ford-fail |=(tan/tang ~|(%ford-fail (mean tan))) :: @@ -591,6 +595,13 @@ %f %exec our ~ [her syd q.mun] (lobe-to-silk:ze r.mun p.dat) == :: + ++ blas + |= {hen/duct das/(set mood)} + ^+ +> + ?> ?=(^ das) + =- (emit hen %give %wris q.n.das -) + (~(run in `(set mood)`das) |=(m/mood [p.m r.m])) + :: :: Give next step in a subscription. :: ++ bleb @@ -625,6 +636,7 @@ :: ++ blub-all (duct-lift |=({a/duct $~} (blub a))) :: lifted ++blub ++ blab-all (duct-lift blab) :: lifted ++blab + ++ blas-all (duct-lift blas) :: lifted ++blas ++ balk-all (duct-lift balk) :: lifted ++balk ++ bleb-all (duct-lift bleb) :: lifted ++bleb :: @@ -651,14 +663,14 @@ :: foreign ship. :: ++ duce :: produce request - |= rov/rove + |= wov/wove ^+ +> - =. rov (dedupe rov) - =. qyx (~(put ju qyx) rov hen) + =. wov (dedupe wov) + =. qyx (~(put ju qyx) wov hen) ?~ ref - (mabe rov |=(@da (bait hen +<))) + (mabe q.wov |=(@da (bait hen +<))) |- ^+ +>+.$ - =+ rav=(reve rov) + =+ rav=(reve q.wov) =+ ^= vaw ^- rave ?. ?=({$sing $v *} rav) rav [%many %| [%ud let.dom] `case`q.p.rav r.p.rav] @@ -680,28 +692,69 @@ :: all get filled at once. :: ++ dedupe :: find existing alias - |= rov/rove ^- rove - =; ros/(list rove) ?+(ros rov {^ $~} i.ros) + |= wov/wove + ^- wove + =; won/(unit wove) (fall won wov) + =* rov q.wov ?- -.rov $sing ~ $next - ?~ (case-to-aeon:ze q.p.rov) ~ - %- ~(rep by qyx) - |= {{a/rove *} b/(list rove)} ^+ b - =- ?.(- b [a b]) - ?& ?=($next -.a) - =(p.a p.rov(q q.p.a)) - ?=(^ (case-to-aeon:ze q.p.a)) + =+ aey=(case-to-aeon:ze q.p.rov) + ?~ aey ~ + %- ~(rep in ~(key by qyx)) + |= {haw/wove res/(unit wove)} + ?^ res res + ?. =(p.wov p.haw) ~ + =* hav q.haw + =- ?:(- `haw ~) + ?& ?=($next -.hav) + =(p.hav p.rov(q q.p.hav)) + :: + :: only a match if this request is before + :: or at our starting case. + =+ hay=(case-to-aeon:ze q.p.hav) + ?~(hay | (lte u.hay u.aey)) + == + :: + $mult + =+ aey=(case-to-aeon:ze p.p.rov) + ?~ aey ~ + %- ~(rep in ~(key by qyx)) + |= {haw/wove res/(unit wove)} + ?^ res res + ?. =(p.wov p.haw) ~ + =* hav q.haw + =- ?:(- `haw ~) + ?& ?=($mult -.hav) + =(p.hav p.rov(p p.p.hav)) + :: + :: only a match if this request is before + :: or at our starting case, and it has been + :: tested at least that far. + =+ hay=(case-to-aeon:ze p.p.hav) + ?& ?=(^ hay) + (lte u.hay u.aey) + ?=(^ q.hav) + (gte u.q.hav u.aey) + == == :: $many - ?~ (case-to-aeon:ze p.q.rov) ~ - %- ~(rep by qyx) - |= {{a/rove *} b/(list rove)} ^+ b - =- ?.(- b [a b]) - ?& ?=($many -.a) - =(a rov(p.q p.q.a)) - ?=(^ (case-to-aeon:ze p.q.a)) + =+ aey=(case-to-aeon:ze p.q.rov) + ?~ aey ~ + %- ~(rep in ~(key by qyx)) + |= {haw/wove res/(unit wove)} + ?^ res res + ?. =(p.wov p.haw) ~ + =* hav q.haw + =- ?:(- `haw ~) + ?& ?=($many -.hav) + =(hav rov(p.q p.q.hav)) + :: + :: only a match if this request is before + :: or at our starting case. + =+ hay=(case-to-aeon:ze p.q.hav) + ?~(hay | (lte u.hay u.aey)) == == :: @@ -748,6 +801,55 @@ (lobe-to-silk:ze a p.-) == :: + :: Set permissions for a node. + :: + ++ perm + |= {pax/path rit/rite} + ^+ +> + =/ mis/(set @ta) + %+ roll + =- ~(tap in -) + ?- -.rit + $r who:(fall red.rit *rule) + $w who:(fall wit.rit *rule) + $rw (~(uni in who:(fall red.rit *rule)) who:(fall wit.rit *rule)) + == + |= {w/whom s/(set @ta)} + ?: |(?=($& -.w) (~(has by cez) p.w)) s + (~(put in s) p.w) + ?^ mis + =- (emit hen %give %mack `[%leaf "No such group(s): {-}"]~) + %+ roll ~(tap in `(set @ta)`mis) + |= {g/@ta t/tape} + ?~ t (trip g) + :(weld t ", " (trip g)) + =< (emit hen %give %mack ~) + ?- -.rit + $r wake(per (put-perm per pax red.rit)) + $w wake(pew (put-perm pew pax wit.rit)) + $rw wake(per (put-perm per pax red.rit), pew (put-perm pew pax wit.rit)) + == + :: + ++ put-perm + |= {pes/regs pax/path new/(unit rule)} + ?~ new (~(del by pes) pax) + (~(put by pes) pax u.new) + :: + :: Remove a group from all rules. + :: + ++ forget-crew + |= nom/@ta + %= +> + per (forget-crew-in nom per) + pew (forget-crew-in nom pew) + == + :: + ++ forget-crew-in + |= {nom/@ta pes/regs} + %- ~(run by pes) + |= r/rule + r(who (~(del in who.r) |+nom)) + :: :: Cancel a request. :: :: For local requests, we just remove it from `qyx`. For foreign requests, @@ -755,17 +857,17 @@ :: ++ cancel-request :: release request ^+ . - =^ ros/(list rove) qyx + =^ wos/(list wove) qyx :_ (~(run by qyx) |=(a/(set duct) (~(del in a) hen))) %- ~(rep by qyx) - |= {{a/rove b/(set duct)} c/(list rove)} + |= {{a/wove b/(set duct)} c/(list wove)} ?.((~(has in b) hen) c [a c]) ?~ ref => .(ref `(unit rind)`ref) :: XX TMI - ?: =(~ ros) + :: XX handle? + ?: =(~ wos) + :: XX handle? |- ^+ +> - ?~ ros +> - $(ros t.ros, +> (mabe i.ros |=(@da (best hen +<)))) + ?~ wos +> + $(wos t.wos, +> (mabe q.i.wos |=(@da (best hen +<)))) ^+ ..cancel-request =+ nux=(~(get by fod.u.ref) hen) ?~ nux ..cancel-request @@ -783,54 +885,113 @@ :: and then waiting if the subscription range extends into the future. :: ++ start-request - |= rav/rave + |= {for/(unit ship) rav/rave} ^+ +> ?- -.rav $sing - =+ ver=(aver p.rav) + =+ ver=(aver for p.rav) ?~ ver - (duce rav) + (duce for rav) ?~ u.ver (blub hen) (blab hen p.rav u.u.ver) :: - $next - =+ ver=(aver p.rav) - ?~ ver - (duce [- p ~]:rav) - ?~ u.ver - (blub hen) - =+ yon=+((need (case-to-aeon:ze q.p.rav))) - |- ^+ +>.^$ + :: for %mult and %next, get the data at the specified case, then go forward + :: in time until we find a change (as long as we have no unknowns). + :: if we find no change, store request for later. + :: %next is just %mult with one path, so we pretend %next = %mult here. + ?($next $mult) + |^ + =+ cas=?:(?=($next -.rav) q.p.rav p.p.rav) + =+ aey=(case-to-aeon:ze cas) + :: if the requested case is in the future, we can't know anything yet. + ?~ aey (store ~ ~ ~) + =+ old=(read-all-at cas) + =+ yon=+((need (case-to-aeon:ze cas))) + |- ^+ ..start-request + :: if we need future revisions to look for change, wait. ?: (gth yon let.dom) - (duce -.rav p.rav u.ver) - =+ var=(aver p.rav(q [%ud yon])) - ?~ var - ~& [%oh-no rave=rav aeon=yon letdom=let.dom] - +>.^$ - ?~ u.var - (blab hen p.rav %& %null [%atom %n ~] ~) :: only her %x - ?: (equivalent-data:ze u.u.ver u.u.var) - $(yon +(yon)) - (blab hen p.rav u.u.var) + (store `yon old ~) + =+ new=(read-all-at [%ud yon]) + :: if we don't know everything now, store the request for later. + ?. &((levy ~(tap by old) know) (levy ~(tap by new) know)) + (store `yon old new) + :: if we do know everything now, compare old and new. + :: if there are differences, send response. if not, try next aeon. + =; res + ?~ res $(yon +(yon)) + (respond res) + %+ roll ~(tap by old) + |= $: {{car/care pax/path} ole/cach} + res/(map mood (each cage lobe)) + == + =+ neu=(~(got by new) car pax) + ?< |(?=($~ ole) ?=($~ neu)) + =- ?~(- res (~(put by res) u.-)) + ^- (unit (pair mood (each cage lobe))) + =+ mod=[car [%ud yon] pax] + ?~ u.ole + ?~ u.neu ~ :: not added + `[mod u.u.neu] :: added + ?~ u.neu + `[mod [%& %null [%atom %n ~] ~]] :: deleted + ?: (equivalent-data:ze u.u.neu u.u.ole) ~ :: unchanged + `[mod u.u.neu] :: changed + :: + ++ store :: check again later + |= $: nex/(unit aeon) + old/(map (pair care path) cach) + new/(map (pair care path) cach) + == + ^+ ..start-request + %+ duce for + ^- rove + ?: ?=($mult -.rav) + [-.rav p.rav nex old new] + :+ -.rav p.rav + =+ ole=~(tap by old) + ?> (lte (lent ole) 1) + ?~ ole ~ + q:(snag 0 `(list (pair (pair care path) cach))`ole) + :: + ++ respond :: send changes + |= res/(map mood (each cage lobe)) + ^+ ..start-request + ?: ?=($mult -.rav) (blas hen ~(key by res)) + ?> ?=({* $~ $~} res) + (blab hen n.res) + :: + ++ know |=({(pair care path) c/cach} ?=(^ c)) :: know about file + :: + ++ read-all-at :: files at case, maybe + |= cas/case + %- ~(gas by *(map (pair care path) cach)) + =/ req/(set (pair care path)) + ?: ?=($mult -.rav) q.p.rav + [[p.p.rav r.p.rav] ~ ~] + %+ turn ~(tap by req) + |= {c/care p/path} + ^- (pair (pair care path) cach) + [[c p] (aver for c cas p)] + -- :: $many =+ nab=(case-to-aeon:ze p.q.rav) ?~ nab ?> =(~ (case-to-aeon:ze q.q.rav)) - (duce (rive rav)) + (duce for [- p q ~]:rav) =+ huy=(case-to-aeon:ze q.q.rav) ?: &(?=(^ huy) |((lth u.huy u.nab) &(=(0 u.huy) =(0 u.nab)))) (blub hen) =+ top=?~(huy let.dom u.huy) - =+ ear=(lobes-at-path:ze top r.q.rav) + =+ ear=(lobes-at-path:ze for top r.q.rav) =. +>.$ (bleb hen u.nab ?:(p.rav ~ `[u.nab top])) ?^ huy (blub hen) =+ ^= ptr ^- case [%ud +(let.dom)] - (duce `rove`[%many p.rav ptr q.q.rav r.q.rav ear]) + (duce for `rove`[%many p.rav [ptr q.q.rav r.q.rav] ear]) == :: :: Print a summary of changes to dill. @@ -851,7 +1012,7 @@ |= a/cord ?: ((sane %ta) a) [%leaf (trip a)] - [%leaf (dash:us (trip a) '\'')] + [%leaf (dash:us (trip a) '\'' ~)] $(p.lem t.p.lem) == :: @@ -1399,6 +1560,9 @@ ?- p.p.u.rut $d ~| %totally-temporary-error-please-replace-me + !! + $p + ~| %requesting-foreign-permissions-is-invalid !! $u ~| %im-thinkin-its-prolly-a-bad-idea-to-request-rang-over-the-network @@ -1628,6 +1792,9 @@ `p.q.p.rov :: $next ~ + :: + $mult ~ + :: $many %^ hunt lth ?. ?=($da -.p.q.rov) ~ @@ -1644,68 +1811,154 @@ ?- -.rov $sing rov $next [- p]:rov - $many [%many p.rov p.q.rov q.q.rov r.q.rov] + $mult [- p]:rov + $many [- p q]:rov == :: - ++ rive - |= rav/{$many p/? q/moat} - ^- rove - [%many p.rav p.q.rav q.q.rav r.q.rav ~] - :: :: Loop through open subscriptions and check if we can fill any of them. :: ++ wake :: update subscribers ^+ . =+ xiq=~(tap by qyx) - =| xaq/(list {p/rove q/(set duct)}) + =| xaq/(list {p/wove q/(set duct)}) |- ^+ ..wake ?~ xiq ..wake(qyx (~(gas by *cult) xaq)) ?: =(~ q.i.xiq) $(xiq t.xiq, xaq xaq) :: drop forgotten - ?- -.p.i.xiq + =* for p.p.i.xiq + =* rov q.p.i.xiq + ?- -.rov $sing - =+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.p.i.xiq)) + =+ cas=?~(ref ~ (~(get by haw.u.ref) `mood`p.rov)) ?^ cas %= $ xiq t.xiq ..wake ?~ u.cas (blub-all q.i.xiq ~) - (blab-all q.i.xiq p.p.i.xiq %& u.u.cas) + (blab-all q.i.xiq p.rov %& u.u.cas) == - =+ nao=(case-to-aeon:ze q.p.p.i.xiq) + =+ nao=(case-to-aeon:ze q.p.rov) ?~ nao $(xiq t.xiq, xaq [i.xiq xaq]) :: ~& %reading-at-aeon - =+ vid=(read-at-aeon:ze u.nao p.p.i.xiq) + =+ vid=(read-at-aeon:ze for u.nao p.rov) :: ~& %red-at-aeon ?~ vid :: ?: =(0 u.nao) - :: ~& [%oh-poor `path`[syd '0' r.p.p.i.xiq]] + :: ~& [%oh-poor `path`[syd '0' r.p.rov]] :: $(xiq t.xiq) - :: ~& [%oh-well desk=syd mood=p.p.i.xiq aeon=u.nao] + :: ~& [%oh-well desk=syd mood=p.rov aeon=u.nao] $(xiq t.xiq, xaq [i.xiq xaq]) - $(xiq t.xiq, ..wake (balk-all q.i.xiq u.vid p.p.i.xiq)) + $(xiq t.xiq, ..wake (balk-all q.i.xiq u.vid p.rov)) :: - $next - =* mun p.p.i.xiq - :: =* dat q.p.i.xiq XX can't fuse right now - ?~ q.p.i.xiq - =+ ver=(aver mun) - ?~ ver - $(xiq t.xiq, xaq [i.xiq xaq]) - ?~ u.ver - $(xiq t.xiq, ..wake (blub-all q.i.xiq ~)) - $(xiq t.xiq, xaq [i.xiq(q.p u.ver) xaq]) - =+ var=(aver mun(q [%ud let.dom])) - ?~ var - ~& [%oh-noes mood=mun letdom=let.dom] - $(xiq t.xiq) - ?~ u.var - $(xiq t.xiq, ..wake (blab-all q.i.xiq mun %& %null [%atom %n ~] ~)) - ?: (equivalent-data:ze u.q.p.i.xiq u.u.var) - $(xiq t.xiq, xaq [i.xiq xaq]) - $(xiq t.xiq, ..wake (blab-all q.i.xiq mun u.u.var)) + :: %next is just %mult with one path, so we pretend %next = %mult here. + ?($next $mult) + :: because %mult requests need to wait on multiple files for each + :: revision that needs to be checked for changes, we keep two cache maps. + :: {old} is the revision at {(dec yon)}, {new} is the revision at {yon}. + :: if we have no {yon} yet, that means it was still unknown last time + :: we checked. + =* vor rov + |^ + =/ rov/rove + ?: ?=($mult -.vor) vor + :* %mult + [q.p.vor [[p.p.vor r.p.vor] ~ ~]] + `let.dom + [[[p.p.vor r.p.vor] q.vor] ~ ~] + ~ + == + ?> ?=($mult -.rov) + =* mol p.rov + =* yon q.rov + =* old r.rov + =* new s.rov + :: we will either respond, or store the maybe updated request. + =; res/(each (map mood (each cage lobe)) rove) + ?: ?=($& -.res) + (respond p.res) + (store p.res) + |- :: so that we can retry for the next aeon if possible/needed. + :: if we don't have an aeon yet, see if we have one now. + ?~ yon + =+ aey=(case-to-aeon:ze p.mol) + :: if we still don't, wait. + ?~ aey |+rov + :: if we do, update the request and retry. + $(rov [-.rov mol `+(u.aey) ~ ~]) + :: if old isn't complete, try filling in the gaps. + =? old !(complete old) + (read-unknown mol(p [%ud (dec u.yon)]) old) + :: if the next aeon we want to compare is in the future, wait again. + =+ aey=(case-to-aeon:ze [%ud u.yon]) + ?~ aey |+rov + :: if new isn't complete, try filling in the gaps. + =? new !(complete new) + (read-unknown mol(p [%ud u.yon]) new) + :: if they're still not both complete, wait again. + ?. ?& (complete old) + (complete new) + == + |+rov + :: if there are any changes, send response. if none, move onto next aeon. + =; res + ?^ res &+res + $(rov [-.rov mol `+(u.yon) old ~]) + %+ roll ~(tap by old) + |= $: {{car/care pax/path} ole/cach} + res/(map mood (each cage lobe)) + == + =+ neu=(~(got by new) car pax) + ?< |(?=($~ ole) ?=($~ neu)) + =- ?~(- res (~(put by res) u.-)) + ^- (unit (pair mood (each cage lobe))) + =+ mod=[car [%ud u.yon] pax] + ?~ u.ole + ?~ u.neu ~ :: not added + `[mod u.u.neu] :: added + ?~ u.neu + `[mod [%& %null [%atom %n ~] ~]] :: deleted + ?: (equivalent-data:ze u.u.neu u.u.ole) ~ :: unchanged + `[mod u.u.neu] :: changed + :: + ++ store :: check again later + |= rov/rove + ^+ ..wake + =- ^^$(xiq t.xiq, xaq [i.xiq(p [for -]) xaq]) + ?> ?=($mult -.rov) + ?: ?=($mult -.vor) rov + ?> ?=({* $~ $~} r.rov) + =* one n.r.rov + [%next [p.p.one p.p.rov q.p.one] q.one] + :: + ++ respond :: send changes + |= res/(map mood (each cage lobe)) + ^+ ..wake + ::NOTE want to use =-, but compiler bug? + ?: ?=($mult -.vor) + ^^$(xiq t.xiq, ..wake (blas-all q.i.xiq ~(key by res))) + ?> ?=({* $~ $~} res) + ^^$(xiq t.xiq, ..wake (blab-all q.i.xiq n.res)) + :: + ++ complete :: no unknowns + |= hav/(map (pair care path) cach) + ?& ?=(^ hav) + (levy ~(tap by `(map (pair care path) cach)`hav) know) + == + :: + ++ know |=({(pair care path) c/cach} ?=(^ c)) :: know about file + :: + ++ read-unknown :: fill in the blanks + |= {mol/mool hav/(map (pair care path) cach)} + %. |= {{c/care p/path} o/cach} + ?^(o o (aver for c p.mol p)) + =- ~(urn by -) + ?^ hav hav + %- ~(gas by *(map (pair care path) cach)) + (turn ~(tap in q.mol) |=({c/care p/path} [[c p] ~])) + -- :: $many - =+ mot=`moot`q.p.i.xiq + =+ mot=`moat`q.rov + =* sav r.rov =+ nab=(case-to-aeon:ze p.mot) ?~ nab $(xiq t.xiq, xaq [i.xiq xaq]) @@ -1714,19 +1967,19 @@ =. p.mot [%ud +(let.dom)] %= $ xiq t.xiq - xaq [i.xiq(q.p mot) xaq] + xaq [i.xiq(q.q.p mot) xaq] ..wake =+ ^= ear - (lobes-at-path:ze let.dom r.mot) - ?: =(s.mot ear) ..wake - (bleb-all q.i.xiq let.dom ?:(p.p.i.xiq ~ `[u.nab let.dom])) + (lobes-at-path:ze for let.dom r.mot) + ?: =(sav ear) ..wake + (bleb-all q.i.xiq let.dom ?:(p.rov ~ `[u.nab let.dom])) == %= $ xiq t.xiq ..wake =- (blub-all:- q.i.xiq ~) =+ ^= ear - (lobes-at-path:ze u.huy r.mot) - ?: =(s.mot ear) (blub-all q.i.xiq ~) - (bleb-all q.i.xiq +(u.nab) ?:(p.p.i.xiq ~ `[u.nab u.huy])) + (lobes-at-path:ze for u.huy r.mot) + ?: =(sav ear) (blub-all q.i.xiq ~) + (bleb-all q.i.xiq +(u.nab) ?:(p.rov ~ `[u.nab u.huy])) == == ++ drop-me @@ -1750,7 +2003,7 @@ :: and content :: -- creating commits and content and adding them to the tree :: -- finding which data needs to be sent over the network to keep the - :: -- other urbit up-to-date + :: other urbit up-to-date :: -- reading from the file tree through different `++care` options :: -- the `++me` core for merging. :: @@ -2016,9 +2269,11 @@ :: Gets a map of the data at the given path and all children of it. :: ++ lobes-at-path - |= {yon/aeon pax/path} + |= {for/(unit ship) yon/aeon pax/path} ^- (map path lobe) ?: =(0 yon) ~ + :: we use %z for the check because it looks at all child paths. + ?: |(?=($~ for) (may-read u.for %z yon pax)) ~ %- malt %+ skim %~ tap by @@ -2102,6 +2357,66 @@ $delta (~(put in $(lob q.q.gar)) lob) == :: + :: + :: Gets the permissions that apply to a particular node. + :: + :: If the node has no permissions of its own, we use its parent's. + :: If no permissions have been set for the entire tree above the node, + :: we default to fully private (empty whitelist). + :: + ++ read-p + |= {aeon pax/path} + ^- (unit (unit (each cage lobe))) + =- [~ ~ %& %noun !>(-)] + :- (read-p-in pax per.red) + (read-p-in pax pew.red) + :: + ++ read-p-in + |= {pax/path pes/regs} + ^- dict + =+ rul=(~(get by pes) pax) + ?^ rul [pax u.rul] + ?~ pax [/ %white ~] + $(pax (scag (dec (lent pax)) `path`pax)) + :: + ++ may-read + |= {who/ship car/care yon/aeon pax/path} + ^- ? + ?+ car + (allowed-by who pax per.red) + :: + $p + =(who our) + :: + ?($y $z) + =+ tak=(~(get by hit.dom) yon) + ?~ tak | + =+ yak=(tako-to-yaki u.tak) + =+ len=(lent pax) + =- (levy ~(tap in -) |=(p/path (allowed-by who p per.red))) + %+ roll ~(tap in (~(del in ~(key by q.yak)) pax)) + |= {p/path s/(set path)} + ?. =(pax (scag len p)) s + %- ~(put in s) + ?: ?=($z car) p + (scag +(len) p) + == + :: + ++ may-write + |= {w/ship p/path} + (allowed-by w p pew.red) + :: + ++ allowed-by + |= {who/ship pax/path pes/regs} + ^- ? + =+ rul=rul:(read-p-in pax pes) + =- ?:(?=($black mod.rul) !- -) + %- ~(rep in who.rul) + |= {w/whom h/_|} + ?: h & + ?: ?=($& -.w) =(p.w who) + (~(has in (fall (~(get by cez) p.w) ~)) who) + :: :: Checks for existence of a node at an aeon. :: :: This checks for existence of content at the node, and does *not* look @@ -2259,8 +2574,10 @@ :: Should change last few lines to an explicit ++read-w. :: ++ read-at-aeon :: read-at-aeon:ze - |= {yon/aeon mun/mood} :: seek and read + |= {for/(unit ship) yon/aeon mun/mood} :: seek and read ^- (unit (unit (each cage lobe))) + ?. |(?=($~ for) (may-read u.for p.mun yon r.mun)) + ~ ?- p.mun $w ?. ?=($ud -.q.mun) ?^(r.mun ~ [~ ~ %& %aeon !>(yon)]) @@ -2274,6 +2591,7 @@ ~&(%no-cd-path [~ ~]) [~ ~ %& %noun !>(~(key by dos.u.rom))] :: + $p (read-p yon r.mun) $u (read-u yon r.mun) $v (bind (read-v yon r.mun) (lift |=(a/cage [%& a]))) $x (read-x yon r.mun) @@ -3212,7 +3530,7 @@ :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: =| :: instrument state - $: $1 :: vane version + $: $0 :: vane version ruf/raft :: revision tree == :: |= {now/@da eny/@ ski/sley} :: activate @@ -3222,49 +3540,91 @@ |= $: hen/duct hic/(hypo (hobo task:able)) == + =* req q.hic => %= . :: XX temporary - q.hic + req ^- task:able - ?: ?=($soft -.q.hic) + ?: ?=($soft -.req) =+ - ~|([%bad-soft (@t -.p.q.hic)] ((soft task:able) p.q.hic)) + ~|([%bad-soft (@t -.p.req)] ((soft task:able) p.req)) ?~ - - ~& [%bad-softing (@t -.p.q.hic)] !! + ~& [%bad-softing (@t -.p.req)] !! u.- - ?: (~(nest ut -:!>(*task:able)) | p.hic) q.hic - ~& [%clay-call-flub (@tas `*`-.q.hic)] - ((hard task:able) q.hic) + ?: (~(nest ut -:!>(*task:able)) | p.hic) req + ~& [%clay-call-flub (@tas `*`-.req)] + ((hard task:able) req) == ^+ [p=*(list move) q=..^$] - ?- -.q.hic + ?- -.req $boat :_ ..^$ [hen %give %hill (turn ~(tap by mon.ruf) head)]~ + ::. + $cred + =. cez.ruf + ?~ cew.req (~(del by cez.ruf) nom.req) + (~(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 [[[hen %give %mack ~] mos] ..^^$] + =+ den=((de now hen ruf) [. .]:our.req i.des) + =^ mor ruf + =< abet:wake + ?: ?=(^ cew.req) den + (forget-crew:den nom.req) + $(des t.des, mos (weld mos mor)) + :: + $crew + [[hen %give %cruz cez.ruf]~ ..^$] + :: + $crow + =+ rom=(fall (~(get by fat.ruf) our.req) *room) + =+ des=~(tap by dos.rom) + =| rus/(map desk {r/regs w/regs}) + |^ + ?~ des [[hen %give %croz rus]~ ..^^$] + =+ per=(filter-rules per.q.i.des) + =+ pew=(filter-rules pew.q.i.des) + =? rus |(?=(^ per) ?=(^ pew)) + (~(put by rus) p.i.des per pew) + $(des t.des) + :: + ++ filter-rules + |= pes/regs + ^+ pes + =- (~(gas in *regs) -) + %+ skim ~(tap by pes) + |= {p/path r/rule} + (~(has in who.r) |+nom.req) + -- :: $drop =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) + =+ den=((de now hen ruf) [. .]:our.req des.req) abet:drop-me:den [mos ..^$] :: $info - ?: =(%$ q.q.hic) + ?: =(%$ des.req) [~ ..^$] =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) - abet:(edit:den now r.q.hic) + =+ den=((de now hen ruf) [. .]:our.req des.req) + abet:(edit:den now dit.req) [mos ..^$] :: $init :_ %_ ..^$ fat.ruf - ?< (~(has by fat.ruf) p.q.hic) - (~(put by fat.ruf) p.q.hic [-(hun hen)]:[*room .]) + ?< (~(has by fat.ruf) our.req) + (~(put by fat.ruf) our.req [-(hun hen)]:[*room .]) == - =+ [bos=(sein:title p.q.hic) can=(clan:title p.q.hic)] + =+ [bos=(sein:title our.req) can=(clan:title our.req)] %- zing ^- (list (list move)) - :~ ?: =(bos p.q.hic) ~ - [hen %pass /init-merge %c %merg p.q.hic %base bos %kids da+now %init]~ + :~ ?: =(bos our.req) ~ + [hen %pass /init-merge %c %merg our.req %base bos %kids da+now %init]~ :: ~ == @@ -3272,9 +3632,9 @@ $into =. hez.ruf `hen :_ ..^$ - =+ bem=(~(get by mon.ruf) p.q.hic) - ?: &(?=($~ bem) !=(%$ p.q.hic)) - ~|([%bad-mount-point-from-unix p.q.hic] !!) + =+ bem=(~(get by mon.ruf) des.req) + ?: &(?=($~ bem) !=(%$ des.req)) + ~|([%bad-mount-point-from-unix des.req] !!) =+ ^- bem/beam ?^ bem u.bem @@ -3286,7 +3646,7 @@ ?~ dos ~ ?: =(0 let.dom.u.dos) - =+ cos=(mode-to-soba ~ s.bem q.q.hic r.q.hic) + =+ cos=(mode-to-soba ~ s.bem all.req fis.req) =+ ^- {one/(list {path miso}) two/(list {path miso})} %+ skid cos |= {a/path b/miso} @@ -3298,80 +3658,91 @@ [hen %pass /two %c %info p.bem 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) q.q.hic r.q.hic) + =+ cos=(mode-to-soba q.yak (flop s.bem) all.req fis.req) [hen %pass /both %c %info p.bem q.bem %& cos]~ :: $merg :: direct state up - ?: =(%$ q.q.hic) + ?: =(%$ des.req) [~ ..^$] =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.hic q.q.hic) - abet:abet:(start:(me:ze:den [r.q.hic s.q.hic] ~ &) t.q.hic u.q.hic) + =+ den=((de now hen ruf) [. .]:our.req des.req) + abet:abet:(start:(me:ze:den [her.req dem.req] ~ &) cas.req how.req) [mos ..^$] :: $mont =. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~]) - =+ pot=(~(get by mon.ruf) p.q.hic) + =+ pot=(~(get by mon.ruf) des.req) ?^ pot ~& [%already-mounted pot] [~ ..^$] + =* bem bem.req =. mon.ruf - (~(put by mon.ruf) p.q.hic [p.q.q.hic q.q.q.hic r.q.q.hic] s.q.q.hic) - =+ yar=(~(get by fat.ruf) p.q.q.hic) + (~(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.q.q.hic) + =+ dos=(~(get by dos.u.yar) q.bem) ?~ dos [~ ..^$] =^ mos ruf - =+ den=((de now hen ruf) [. .]:p.q.q.hic q.q.q.hic) - abet:(mont:den p.q.hic q.q.hic) + =+ den=((de now hen ruf) [. .]:p.bem q.bem) + abet:(mont:den des.req bem) [mos ..^$] :: $dirk ?~ hez.ruf ~& %no-sync-duct [~ ..^$] - ?. (~(has by mon.ruf) p.q.hic) - ~& [%not-mounted p.q.hic] + ?. (~(has by mon.ruf) des.req) + ~& [%not-mounted des.req] [~ ..^$] - :- ~[[u.hez.ruf %give %dirk p.q.hic]] + :- ~[[u.hez.ruf %give %dirk des.req]] ..^$ :: $ogre ?~ hez.ruf ~& %no-sync-duct [~ ..^$] - ?@ p.q.hic - ?. (~(has by mon.ruf) p.q.hic) - ~& [%not-mounted p.q.hic] + =* pot pot.req + ?@ pot + ?. (~(has by mon.ruf) pot) + ~& [%not-mounted pot] [~ ..^$] - :_ ..^$(mon.ruf (~(del by mon.ruf) p.q.hic)) - [u.hez.ruf %give %ogre p.q.hic]~ + :_ ..^$(mon.ruf (~(del by mon.ruf) pot)) + [u.hez.ruf %give %ogre pot]~ :_ %_ ..^$ mon.ruf %- molt %+ skip ~(tap by mon.ruf) - (corl (cury test p.q.hic) tail) + (corl (cury test pot) tail) == %+ turn - (skim ~(tap by mon.ruf) (corl (cury test p.q.hic) tail)) - |= {pot/term bem/beam} - [u.hez.ruf %give %ogre pot] + (skim ~(tap by mon.ruf) (corl (cury test pot) tail)) + |= {pon/term bem/beam} + [u.hez.ruf %give %ogre pon] :: - $warp + $perm =^ mos ruf - =+ den=((de now hen ruf) p.q.hic p.q.q.hic) - :: =- ~? ?=([~ %sing %w *] q.q.q.hic) - :: :* %someones-warping - :: rav=u.q.q.q.hic - :: mos=-< - :: == - :: - + ::TODO after new boot system, just use our from global. + =+ den=((de now hen ruf) [. .]:our.req des.req) + abet:(perm:den pax.req rit.req) + [mos ..^$] + :: + ?($warp $werp) + =^ for req + ?: ?=($warp -.req) + [~ req] + :_ [%warp wer.req rif.req] + ?: =(who.req p.wer.req) ~ + `who.req + ?> ?=($warp -.req) + =* rif rif.req + =^ mos ruf + =+ den=((de now hen ruf) wer.req p.rif) =< abet - ?~ q.q.q.hic + ?~ q.rif cancel-request:den - (start-request:den u.q.q.q.hic) + (start-request:den for u.q.rif) [mos ..^$] :: $went @@ -3379,21 +3750,23 @@ !! :: $west - ?: ?=({$question *} q.q.hic) - =+ ryf=((hard riff) r.q.hic) + =* wer wer.req + =* pax pax.req + ?: ?=({$question *} pax) + =+ ryf=((hard riff) res.req) :_ ..^$ :~ [hen %give %mack ~] :- hen - :^ %pass [(scot %p p.p.q.hic) (scot %p q.p.q.hic) t.q.q.hic] + :^ %pass [(scot %p p.wer) (scot %p q.wer) t.pax] %c - [%warp [p.p.q.hic p.p.q.hic] ryf] + [%werp q.wer [p.wer p.wer] ryf] == - ?> ?=({$answer @ @ $~} q.q.hic) - =+ syd=(slav %tas i.t.q.q.hic) - =+ inx=(slav %ud i.t.t.q.q.hic) + ?> ?=({$answer @ @ $~} pax) + =+ syd=(slav %tas i.t.pax) + =+ inx=(slav %ud i.t.t.pax) =^ mos ruf - =+ den=((de now hen ruf) p.q.hic syd) - abet:(take-foreign-update:den inx ((hard (unit rand)) r.q.hic)) + =+ den=((de now hen ruf) wer syd) + abet:(take-foreign-update:den inx ((hard (unit rand)) res.req)) [[[hen %give %mack ~] mos] ..^$] :: $wegh @@ -3418,32 +3791,12 @@ :: ++ load => |% - ++ cult-0 (map duct rove) - ++ dojo-0 (cork dojo |=(a/dojo a(qyx *cult-0))) - ++ rede-0 (cork rede |=(a/rede a(qyx *cult-0))) - ++ room-0 (cork room |=(a/room a(dos (~(run by dos.a) dojo-0)))) - ++ rung-0 (cork rung |=(a/rung a(rus (~(run by rus.a) rede-0)))) - ++ raft-0 - %+ cork raft - |=(a/raft a(fat (~(run by fat.a) room-0), hoy (~(run by hoy.a) rung-0))) - ++ axle $%({$0 ruf/raft-0} {$1 ruf/raft}) + ++ axle $%({$0 ruf/raft}) -- |= old/axle ^+ ..^$ ?- -.old - $1 ..^$(ruf ruf.old) - $0 =/ cul - |= a/cult-0 ^- cult - %- ~(gas ju *cult) - (turn ~(tap by a) |=({p/duct q/rove} [q p])) - =/ rom - =+ doj=|=(a/dojo-0 a(qyx (cul qyx.a))) - |=(a/room-0 a(dos (~(run by dos.a) doj))) - =/ run - =+ red=|=(a/rede-0 a(qyx (cul qyx.a))) - |=(a/rung-0 a(rus (~(run by rus.a) red))) - =+ r=ruf.old - $(old [%1 r(fat (~(run by fat.r) rom), hoy (~(run by hoy.r) run))]) + $0 ..^$(ruf ruf.old) == :: ++ scry :: inspect @@ -3460,14 +3813,22 @@ [~ ~] =+ run=((soft care) ren) ?~ run [~ ~] + ::TODO if it ever gets filled properly, pass in the full fur. + =/ for/(unit ship) + %- ~(rep in (fall fur ~)) + |= {m/monk s/(unit ship)} + ?^ s s + ?: ?=($| -.m) ~ + ?: =(p.m his) ~ + `p.m =+ den=((de now [/scryduct ~] ruf) [. .]:his syd) - =+ (aver:den u.run u.luk tyl) + =+ (aver:den for u.run u.luk tyl) ?~ - - ?~ u.- - ?: ?=($& -.u.u.-) ``p.u.u.- ~ :: -++ stay [%1 ruf] +++ stay [%0 ruf] ++ take :: accept response |= {tea/wire hen/duct hin/(hypo sign)} ^+ [p=*(list move) q=..^$] diff --git a/sys/vane/dill.hoon b/sys/vane/dill.hoon index 76983aa7d..4c68ae188 100644 --- a/sys/vane/dill.hoon +++ b/sys/vane/dill.hoon @@ -7,15 +7,9 @@ ++ gill (pair ship term) :: general contact -- :: => |% :: console protocol -++ all-axle ?(old-axle axle) :: -++ old-axle :: all dill state - $: $2 :: - ore/(unit ship) :: identity once set - hey/(unit duct) :: default duct - dug/(map duct axon) :: conversations - == :: +++ all-axle ?(axle) :: ++ axle :: - $: $3 :: + $: $0 :: ore/(unit ship) :: identity once set hey/(unit duct) :: default duct dug/(map duct axon) :: conversations @@ -47,7 +41,8 @@ == :: ++ 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 + {$warp p/sock q/riff:clay} :: wait for clay hack + {$perm p/ship q/desk r/path s/rite:clay} :: change permissions == :: ++ note-dill :: note to self, odd $% {$crud p/@tas q/(list tank)} :: @@ -79,6 +74,7 @@ $% {$mere p/(each (set path) (pair term tang))} :: {$note p/@tD q/tank} :: {$writ p/riot:clay} :: + {$mack p/(unit tang)} :: == :: ++ sign-dill :: $% {$blit p/(list blit)} :: @@ -280,7 +276,8 @@ (sync %home our %base) (init-sync %home our %base) =. +> ?. ?=(?($duke $king $czar) can) +> - (sync %kids our %base) + :: make kids desk publicly readable, so syncs work. + (show %kids):(sync %kids our %base) =. +> autoload =. +> peer |- ^+ +>+ @@ -316,6 +313,16 @@ :_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum]) == :: + ++ show :: permit reads on desk + |= des/desk + %_ +>.$ + moz + :_ moz + :* hen %pass /show %c %perm our + des / r+`[%black ~] + == + == + :: ++ sync |= syn/{desk ship desk} %_ +>.$ @@ -396,6 +403,10 @@ :: {$c $writ *} init + :: + {$c $mack *} + ?~ p.sih +>.$ + (mean >%dill-clay-nack< u.p.sih) :: {$d $blit *} (done +.sih) @@ -503,8 +514,6 @@ :: ++ load :: trivial |= old/all-axle - ?: ?=($2 -.old) - $(old [%3 ore hey dug ~ ~ ~ ~ ~ ~]:old) ..^$(all old) :: |= old=* :: diable :: ..^$(ore.all `~zod) diff --git a/sys/vane/eyre.hoon b/sys/vane/eyre.hoon index 2b21228bb..eec028e8f 100644 --- a/sys/vane/eyre.hoon +++ b/sys/vane/eyre.hoon @@ -85,7 +85,7 @@ -- :: |% :: models ++ bolo :: eyre state - $: $6 :: version + $: $0 :: version gub/@t :: random identity hov/(unit ship) :: master for remote top/beam :: ford serve prefix @@ -2025,15 +2025,10 @@ ~ :: ++ load :: take previous state - =+ driv-5=_=>(*driv [cor=p req=req.q]) - =+ bolo-5={$5 _=+(*bolo +.-(sec (~(run by sec.-) driv-5)))} - =+ bolo-4={$4 _%*(+ *bolo-5 lyv *(map duct ^))} ::|= * %. (bolo +<) - |= old/?(bolo bolo-5 bolo-4) ^+ ..^$ + |= old/?(bolo) ^+ ..^$ ?- -.old - $6 ..^$(+>- old) - $5 $(old [%6 +.old(sec (~(run by sec.old) |=(driv-5 [cor & req])))]) - $4 $(old [%5 +.old(lyv ~)]) :: minor leak + $0 ..^$(+>- old) == :: ++ scry diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index bab86b2e5..274dc100f 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -12,7 +12,7 @@ ++ move {p/duct q/(wind note gift:able)} :: local move ++ note :: out request $-> $% $: $c :: to %clay - $% {$warp p/sock q/riff:clay} :: + $% {$warp p/sock q/riff:clay} :: == == :: $: $f :: to %ford $% {$exec p/@p q/(unit bilk:ford)} :: @@ -33,7 +33,7 @@ -- :: |% :: structures ++ axle :: all %ford state - $: $2 :: version for update + $: $0 :: version for update pol/(map ship baby) :: == :: ++ baby :: state by ship @@ -1599,7 +1599,7 @@ |= {cof/cafe dir/knot} =+ nod=(chap(s.how [dir s.how]) cof bax hon) ?: ?=($2 -.q.nod) - (flue cof) + (flue p.nod) (cope nod (flux some)) %- flux |= doy/(map @ cage) ^- vase diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 7f5689dff..99d587897 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -31,27 +31,11 @@ -- :: |% :::::::::::::::::::::::::::::::::::::::::::::::::::::: %gall state :::::::::::::::::::::::::::::::::::::::::::::::::::::: -++ axle-n ?(axle-1 axle-2 axle-3 axle-4) :: upgrade path -++ axle-1 {$1 pol/(map ship mast-1)} :: -++ mast-1 :: - (cork mast-2 |=(mast-2 +<(bum (~(run by bum) seat-1)))) :: -++ seat-1 :: - (cork seat-2 |=(seat-2 +<+)) :: -++ axle-2 {$2 pol/(map ship mast-2)} :: -++ mast-2 (cork mast-3 |=(mast-3 +<+)) :: -++ seat-2 seat-3 :: -++ axle-3 {$3 pol/(map ship mast-3)} :: -++ mast-3 :: - (cork mast-4 |=(mast-4 +<(bum (~(run by bum) seat-3)))) :: -++ seat-3 :: - (cork seat-4 |=(seat-4 +<+)) :: -++ axle-4 axle :: -++ mast-4 mast :: -++ seat-4 seat :: +++ axle-n ?(axle) :: upgrade path :::::::::::::::::::::::::::::::::::::::::::::::::::::: state proper :::::::::::::::::::::::::::::::::::::::::::::::::::::: ++ axle :: all state - $: $4 :: state version + $: $0 :: state version pol/(map ship mast) :: apps by ship == :: ++ gest :: subscriber data @@ -782,7 +766,7 @@ ?^ -.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (bone)")]) ?@ +.q.vax :_(+>.$ [%| (ap-suck "move: invalid move (card)")]) =+ hun=(~(get by r.zam) -.q.vax) - ?. (~(has by r.zam) -.q.vax) + ?. &((~(has by r.zam) -.q.vax) !=(0 -.q.vax)) :_(+>.$ [%| (ap-suck "move: invalid card (bone {<-.q.vax>})")]) =^ pec vel (~(spot wa vel) 3 vax) =^ cav vel (~(slot wa vel) 3 pec) @@ -1225,6 +1209,9 @@ ~ $cash `%a $conf `%g + $cred `%c + $crew `%c + $crow `%c $deal `%g $exec `%f $flog `%d @@ -1234,6 +1221,7 @@ $mont `%c $nuke `%a $ogre `%c + $perm `%c $serv `%e $them `%e $wait `%b @@ -1307,50 +1295,30 @@ |= old/axle-n ^+ ..^$ ?- -.old - $4 ..^$(all old) - $3 - %= $ - old ^- axle-4 - => |=(seat-3 `seat-4`[*misvale-data +<]) - => |=(mast-3 +<(bum (~(run by bum) +>))) - old(- %4, pol (~(run by pol.old) .)) - == - :: - $2 - %= $ - old ^- axle-3 - => |=(mast-2 [*(unit duct) +<]) - old(- %3, pol (~(run by pol.old) .)) - == - :: - $1 - %= $ - old ^- axle-2 - => |=(seat-1 `seat-2`[*worm +<]) - => |=(mast-1 +<(bum (~(run by bum) +>))) - old(- %2, pol (~(run by pol.old) .)) - == + $0 ..^$(all old) == :: ++ scry - |= {fur/(unit (set monk)) ren/@tas who/ship syd/desk lot/coin tyl/path} + |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} ^- (unit (unit cage)) + ?. ?=($& -.why) ~ + =* his p.why ?: ?& =(%u ren) =(~ tyl) =([%$ %da now] lot) - (~(has by pol.all) who) - (~(has by bum:(~(got by pol.all) who)) syd) + (~(has by pol.all) his) + (~(has by bum:(~(got by pol.all) his)) syd) == ``[%null !>(~)] - ?. (~(has by pol.all) who) + ?. (~(has by pol.all) his) ~ ?. =([%$ %da now] lot) ~ - ?. (~(has by bum:(~(got by pol.all) who)) syd) + ?. (~(has by bum:(~(got by pol.all) his)) syd) [~ ~] ?. ?=(^ tyl) ~ - (mo-peek:(mo-abed:mo who *duct) syd high+`who ren tyl) + (mo-peek:(mo-abed:mo his *duct) syd high+`his ren tyl) :: ++ stay :: save w+o cache `axle`all diff --git a/sys/vane/jael.hoon b/sys/vane/jael.hoon index bef03ab83..f4570b7e9 100644 --- a/sys/vane/jael.hoon +++ b/sys/vane/jael.hoon @@ -913,9 +913,9 @@ ?- -.tac :: :: destroy promises - :: {$ktsg p/ship q/safe} + :: {$burn p/ship q/safe} :: - $ktsg + $burn (cure abet:abet:(deal:(burb our) p.tac [~ q.tac])) :: :: remote update diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 40b252b8c..c68fe4262 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -381,7 +381,9 @@ ++ able ^? |% ++ gift :: out result <-$ - $% {$dirk p/@tas} :: mark mount dirty + $% {$croz rus/(map desk {r/regs w/regs})} :: rules for group + {$cruz cez/(map @ta crew)} :: permission groups + {$dirk p/@tas} :: mark mount dirty {$ergo p/@tas q/mode} :: version update {$hill p/(list @tas)} :: mount points {$mack p/(unit tang)} :: ack @@ -389,23 +391,34 @@ {$mere p/(each (set path) (pair term tang))} :: merge result {$note p/@tD q/tank} :: debug message {$ogre p/@tas} :: delete mount point + {$rule red/dict wit/dict} :: node r+w permissions {$send p/lane:ames q/@} :: transmit packet {$writ p/riot} :: response + {$wris p/case p/(set (pair care path))} :: many changes == :: ++ task :: in request ->$ $% {$boat $~} :: pier rebooted - {$drop p/@p q/desk} :: cancel pending merge - {$info p/@p q/desk r/nori} :: internal edit - {$init p/@p} :: report install - {$into p/desk q/? r/mode} :: external edit - {$merg p/@p q/desk r/@p s/desk t/case u/germ} :: merge desks - {$mont p/desk q/beam} :: mount to unix - {$dirk p/desk} :: mark mount dirty - {$ogre p/$@(desk beam)} :: delete mount point - {$warp p/sock q/riff} :: file request + {$cred our/ship nom/@ta cew/crew} :: set permission group + {$crew our/ship} :: permission groups + {$crow our/ship nom/@ta} :: group usage + {$drop our/@p des/desk} :: cancel pending merge + {$info our/@p des/desk dit/nori} :: internal edit + {$init our/@p} :: report install + {$into des/desk all/? fis/mode} :: external edit + $: $merg :: merge desks + our/@p des/desk :: target + her/@p dem/desk cas/case :: source + how/germ :: method + == :: + {$mont des/desk bem/beam} :: mount to unix + {$dirk des/desk} :: mark mount dirty + {$ogre pot/$@(desk beam)} :: delete mount point + {$perm our/ship des/desk pax/path rit/rite} :: change permissions + {$warp wer/sock rif/riff} :: internal file req + {$werp who/ship wer/sock rif/riff} :: external file req {$wegh $~} :: report memory - {$went p/sack q/path r/@ud s/coop} :: response confirm - {$west p/sack q/path r/*} :: network request + {$went wer/sack pax/path num/@ud ack/coop} :: response confirm + {$west wer/sack pax/path res/*} :: network request == :: -- ::able :: @@ -422,13 +435,15 @@ $% {$delta p/lobe q/{p/mark q/lobe} r/page} :: delta on q {$direct p/lobe q/page} :: immediate == :: - ++ care ?($d $u $v $w $x $y $z) :: clay submode + ++ care ?($d $p $u $v $w $x $y $z) :: clay submode ++ case :: ship desk case spur $% {$da p/@da} :: date {$tas p/@tas} :: label {$ud p/@ud} :: number == :: ++ coop (unit ares) :: e2e ack + ++ crew (set ship) :: permissions group + ++ dict {src/path rul/rule} :: effective permission ++ dome :: project state $: ank/ankh :: state let/@ud :: top id @@ -466,6 +481,7 @@ ++ moat {p/case q/case r/path} :: change range ++ mode (list {path (unit mime)}) :: external files ++ mood {p/care q/case r/path} :: request in desk + ++ mool {p/case q/(set (pair care path))} :: requests in desk ++ nori :: repository action $% {$& p/soba} :: delta {$| p/@tas} :: label @@ -481,17 +497,25 @@ lat/(map lobe blob) :: data == :: ++ rant :: response to request - $: p/{p/care q/case r/@tas} :: clade release book + $: p/{p/care q/case r/desk} :: clade release book q/path :: spur r/cage :: data == :: ++ rave :: general request $% {$sing p/mood} :: single request {$next p/mood} :: await next version + {$mult p/mool} :: next version of any {$many p/? q/moat} :: track range == :: + ++ regs (map path rule) :: rules for paths ++ riff {p/desk q/(unit rave)} :: request+desist + ++ rite :: new permissions + $% {$r red/(unit rule)} :: for read + {$w wit/(unit rule)} :: for write + {$rw red/(unit rule) wit/(unit rule)} :: for read and write + == :: ++ riot (unit rant) :: response+complete + ++ rule {mod/?($black $white) who/(set whom)} :: node permission ++ rump {p/care q/case r/@tas s/path} :: relative path ++ saba {p/ship q/@tas r/moar s/dome} :: patch+merge ++ soba (list {p/path q/miso}) :: delta @@ -504,6 +528,7 @@ {$| p/(list a) q/(list a)} :: p -> q[chunk] == :: ++ urge |*(a/mold (list (unce a))) :: list change + ++ whom (each ship @ta) :: ship or named crew ++ yaki :: commit $: p/(list tako) :: parents q/(map path lobe) :: namespace @@ -937,7 +962,7 @@ :: and change subscriptions. :: :: change tasks are designed to match high-level - :: operations - for instance, we have %ktsg, %mint, + :: operations - for instance, we have %burn, %mint, :: and %move, not just a single delta operation. :: more of these operations will probably be added, :: and invariants enforced at transaction end. @@ -1009,7 +1034,7 @@ action :: change :: += task :: in request ->$ - $% [%ktsg p=ship q=safe] :: destroy rights + $% [%burn p=ship q=safe] :: destroy rights [%hail p=ship q=remote] :: remote update [%init p=@pG q=arms] :: initialize urbit [%meet p=(unit (unit ship)) q=farm] :: integrate pki from diff --git a/tests/new-hoon/ls.hoon b/tests/new-hoon/ls.hoon new file mode 100644 index 000000000..e334bc4c6 --- /dev/null +++ b/tests/new-hoon/ls.hoon @@ -0,0 +1,280 @@ +/+ new-hoon, tester +=, ls:new-hoon +|_ tester-type:tester +++ test-head + (expect-eq (head [1 ~]) 1 "head") +:: +++ test-last + (expect-eq (last:ls [1 2 ~]) 2 "last") +:: +++ test-tail + (expect-eq (tail [1 2 3 ~]) [2 3 ~] "tail") +:: +++ test-init + (expect-eq (init [1 2 3 ~]) [1 2 ~] "init") +:: +++ test-size + (expect-eq (size ['a' 'b' 'c' ~]) 3 "size") +:: +++ test-map + (expect-eq (map:ls [1 2 ~] |=(a/@ (add 1 a))) [2 3 ~] "map") +:: +++ test-reverse + (expect-eq (reverse [1 2 3 ~]) [3 2 1 ~] "reverse") +:: +++ test-intersperse + (expect-eq (intersperse 1 [5 5 5 ~]) [5 1 5 1 5 ~] "intersperse") +:: +++ test-intercalate + %^ expect-eq + (intercalate "," ["one" "two" "three" ~]) + ["one,two,three"] + "intercalate" +:: +++ test-transpose + %^ expect-eq + (transpose ~[~[1 2 3] ~[4 5 6]]) + ~[~[1 4] ~[2 5] ~[3 6]] + "transpose" +:: +++ test-foldl + (expect-eq (foldl [1 2 3 ~] 3 |=({a/@ b/@} (add a b))) 9 "foldl") +:: +++ test-foldr + (expect-eq (foldr [1 2 3 ~] 1 |=({a/@ b/@} (add a b))) 7 "foldr") +:: +++ test-concat + (expect-eq (concat ~[~[1 2] ~[3 4]]) ~[1 2 3 4] "concat") +:: +++ test-weld + (expect-eq (weld:ls ~[1 2 3] ~["one" "two"]) ~[1 2 3 "one" "two"] "weld") +:: +++ test-any-true + (expect-eq (any [1 2 3 ~] |=(a/@ =(a 2))) %.y "any true") +:: +++ test-any-false + (expect-eq (any [1 2 3 ~] |=(a/@ =(a 8))) %.n "any false") +:: +++ test-all-true + (expect-eq (all [1 1 1 ~] |=(a/@ =(a 1))) %.y "all true") +:: +++ test-all-false + (expect-eq (all [1 3 1 ~] |=(a/@ =(a 1))) %.n "all false") +:: +++ test-scanl + %^ expect-eq + (scanl ~[1 2 3] 0 |=({a/@ b/@} (add a b))) + ~[0 1 3 6] + "scanl" +:: +++ test-scanl1 + %^ expect-eq + (scanl1 ~[1 2 3] |=({a/@ b/@} (add a b))) + ~[1 3 6] + "scanl1" +:: +++ test-scanr + %^ expect-eq + (scanr ~[1 2 3] 0 |=({a/@ b/@} (add a b))) + ~[6 5 3 0] + "scanr" +:: +++ test-scanr1 + %^ expect-eq + (scanr1 ~[1 2 3] |=({a/@ b/@} (add a b))) + ~[6 5 3] + "scanr1" +:: +++ test-map-foldl + %^ expect-eq + (map-foldl ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[2 3 5]] + "map-foldl" +:: +++ test-map-foldr + %^ expect-eq + (map-foldr ~[1 2 3] 1 |=({a/@ b/@} [(add a b) (add 1 a)])) + [7 ~[7 5 2]] + "map-foldr" +:: +++ test-unfoldr + %^ expect-eq + (unfoldr 5 |=(a/@ ?:(=(a 0) ~ `[a (dec a)]))) + [5 4 3 2 1 ~] + "unfoldr" +:: +++ test-take + %^ expect-eq + (take 3 ~[1 2 3 4 5]) + [1 2 3 ~] + "take" +:: +++ test-drop + %^ expect-eq + (drop:ls 3 ~[1 2 3 4 5]) + [4 5 ~] + "drop" +:: +++ test-split-at + %^ expect-eq + (split-at 3 ~[1 2 3 4 5]) + [[1 2 3 ~] [4 5 ~]] + "split-at" +:: +++ test-take-while + %^ expect-eq + (take-while ~[1 2 3 4 5] |=(a/@ (lth a 3))) + [1 2 ~] + "take-while" +:: +++ test-drop-while + %^ expect-eq + (drop-while ~[1 2 3 4 5] |=(a/@ (lth a 3))) + [3 4 5 ~] + "drop-while" +:: +++ test-drop-while-end + %^ expect-eq + (drop-while-end ~[5 5 1 5 5] |=(a/@ =(a 5))) + [5 5 1 ~] + "drop-while-end" +:: +++ test-split-on + %^ expect-eq + (split-on ~[1 2 3 4 1 2 3 4] |=(a/@ (lth a 3))) + [[1 2 ~] [3 4 1 2 3 4 ~]] + "split-on" +:: +++ test-break + %^ expect-eq + (break ~[1 2 3 4 1 2 3 4] |=(a/@ (gth a 3))) + [[1 2 3 ~] [4 1 2 3 4 ~]] + "break" +:: +++ test-strip-prefix + %^ expect-eq + (strip-prefix "foo" "foobar") + [~ "bar"] + "break" +:: +++ test-inits + %^ expect-eq + (inits "abc") + ["a" "ab" "abc" ~] + "inits" +:: +++ test-tails + %^ expect-eq + (tails "abc") + ["abc" "bc" "c" ~] + "tails" +:: +++ test-is-prefix-of + %^ expect-eq + (is-prefix-of "foo" "foobar") + %.y + "is-prefix-of" +:: +++ test-is-suffix-of + %^ expect-eq + (is-suffix-of "bar" "foobar") + %.y + "is-suffix-of" +:: +++ test-is-infix-of + %^ expect-eq + (is-infix-of "ob" "foobar") + %.y + "is-infix-of" +:: +++ test-elem + %^ expect-eq + (elem 5 [1 2 3 4 5 ~]) + %.y + "elem" +:: +++ test-lookup + %^ expect-eq + (lookup "two" [["one" 1] ["two" 2] ["three" 3] ~]) + [~ 2] + "lookup" +:: +++ test-find + %^ expect-eq + (find:ls [3 2 1 5 1 2 3 ~] |=(a/@ (gth a 3))) + [~ 5] + "find" +:: +++ test-filter + %^ expect-eq + (filter [1 2 1 2 1 ~] |=(a/@ =(a 2))) + [1 1 1 ~] + "filter" +:: +++ test-partition + %^ expect-eq + (partition [1 2 1 2 1 ~] |=(a/@ =(a 2))) + [[2 2 ~] [1 1 1 ~]] + "partition" +:: +++ test-elem-index + %^ expect-eq + (elem-index 2 [1 2 3 4 ~]) + `1 + "elem-index" +:: +++ test-elem-indices + %^ expect-eq + (elem-indices 2 [1 2 1 2 ~]) + [1 3 ~] + "elem-indices" +:: +++ test-find-index + %^ expect-eq + (find-index [1 2 3 ~] |=(a/@ =(a 2))) + `1 + "find-index" +:: +++ test-find-indices + %^ expect-eq + (find-indices [1 2 1 2 ~] |=(a/@ =(a 2))) + [1 3 ~] + "find-indices" +:: +++ test-zip + %^ expect-eq + (zip [[1 2 3 ~] [4 5 6 ~] [7 8 9 ~] ~]) + [[1 4 7 ~] [2 5 8 ~] [3 6 9 ~] ~] + "zip" +:: +++ test-unique + %^ expect-eq + (unique [1 2 3 1 2 3 ~]) + [1 2 3 ~] + "unique" +:: +++ test-delete + %^ expect-eq + (delete 2 [1 2 3 2 ~]) + [1 3 2 ~] + "delete" +:: +++ test-delete-firsts + %^ expect-eq + (delete-firsts [1 2 2 2 3 4 5 ~] [2 2 5 ~]) + [1 2 3 4 ~] + "delete-firsts" +:: +++ test-union + %^ expect-eq + (union [1 2 3 ~] [4 2 5 ~]) + [1 2 3 4 5 ~] + "union" +:: +++ test-intersect + %^ expect-eq + (intersect [5 6 6 7 8 ~] [9 8 8 6 ~]) + [6 6 8 ~] + "intersect" +-- + diff --git a/tests/new-hoon/mp.hoon b/tests/new-hoon/mp.hoon new file mode 100644 index 000000000..af75fdb9e --- /dev/null +++ b/tests/new-hoon/mp.hoon @@ -0,0 +1,360 @@ +/+ new-hoon, tester +=, dct:new-hoon +=+ four=(from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] ~]) +=+ three=(from-list [[1 "one"] [2 "two"] [3 "three"] ~]) +|_ tester-type:tester +++ test-empty + (expect-eq (empty four) %.n "empty") +:: +++ test-size + (expect-eq (size four) 4 "size") +:: +++ test-member + (expect-eq (member four 4) %.y "member") +:: +++ test-put-with + =+ ints=(from-list [["one" 1] ["two" 2] ["three" 3] ["four" 4] ~]) + %^ expect-eq + (put-with ints "three" 2 add) + (from-list [["one" 1] ["two" 2] ["three" 5] ["four" 4] ~]) + "put-with" +:: +++ test-put-with-key + %^ expect-eq + (put-with-key four 4 "four" |=({a/@ud b/tape c/tape} (weld (scow %ud a) b))) + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "4four"] ~]) + "put-with-key" +:: +++ test-put-lookup-with-key + %^ expect-eq + %- put-lookup-with-key :^ + four + 4 + "five" + |=({key/@ud old/tape new/tape} new) + :- `"four" + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "five"] ~]) + "put-lookup-with-key" +:: +++ test-delete + %^ expect-eq + (delete four 4) + three + "delete" +:: +++ test-adjust + %^ expect-eq + %^ adjust + four + 3 + |=(a/tape (weld "this" a)) + (from-list [[1 "one"] [2 "two"] [3 "thisthree"] [4 "four"] ~]) + "adjust" +:: +++ test-adjust-with-key + %^ expect-eq + %^ adjust-with-key + four + 3 + |=({a/@ud b/tape} (weld (scow %ud a) b)) + (from-list [[1 "one"] [2 "two"] [3 "3three"] [4 "four"] ~]) + "adjust-with-key" +:: +++ test-update + %^ expect-eq + %^ update + four + 3 + |=(a/tape `(maybe tape)`~) + (from-list [[1 "one"] [2 "two"] [4 "four"] ~]) + "update" +:: +++ test-update-with-key + %^ expect-eq + %^ update-with-key + four + 3 + |=({a/@u b/tape} `(maybe tape)`[~ (weld (scow %ud a) b)]) + (from-list [[1 "one"] [2 "two"] [3 "3three"] [4 "four"] ~]) + "update-with-key" +:: +++ test-alter-as-add + %^ expect-eq + %^ alter + four + 5 + |=(a/(maybe tape) `(maybe tape)`[~ "five"]) + (from-list [[1 "one"] [2 "two"] [3 "three"] [4 "four"] [5 "five"] ~]) + "alter (as add)" +:: +++ test-alter-as-delete + %^ expect-eq + %^ alter + four + 2 + |=(a/(maybe tape) `(maybe tape)`~) + (from-list [[1 "one"] [3 "three"] [4 "four"] ~]) + "alter (as delete)" +:: +++ test-alter-as-change + %^ expect-eq + %^ alter + four + 2 + |=(a/(maybe tape) `(maybe tape)`[~ "dos"]) + (from-list [[1 "one"] [2 "dos"] [3 "three"] [4 "four"] ~]) + "alter (as change)" +:: +++ check-alter + :: check random dicts of 50 items with 40 random operations done on them + :: for validity. + %+ check + (generate-dict 50) + |= a/(dict @ud @ud) + :: this is dumb, but use {a} as entropy? + =/ gen (random:new-hoon (jam a)) + =| i/@u + |- + ?: =(i 40) + %.y + =^ key gen (range:gen 0 100) + =^ value gen (range:gen 0 100) + =. a %^ alter-with-key a key + |= {key/@ud current/(maybe @ud)} + ^- (maybe @ud) + =+ action=(mod key 2) + ?: =(action 0) :: return nothing + ~ + ?: =(action 1) :: add/set value + `value + ~ :: impossible + ?. (valid a) + %.n + $(i +(i)) +:: +++ test-union + %^ expect-eq + %+ union + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + (from-list [[1 "left"] [2 "left"] [3 "right"] ~]) + "union" +:: +++ test-union-with + %^ expect-eq + %^ union-with + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + |=({a/tape b/tape} (weld a b)) + (from-list [[1 "left"] [2 "leftright"] [3 "right"] ~]) + "union-with" +:: +++ test-union-with-key + %^ expect-eq + %^ union-with-key + (from-list [[1 "left"] [2 "left"] ~]) + (from-list [[2 "right"] [3 "right"] ~]) + |=({a/@ud b/tape c/tape} :(weld `tape`(scow %ud a) b c)) + (from-list [[1 "left"] [2 "2leftright"] [3 "right"] ~]) + "union-with-key" +:: +++ test-map + %^ expect-eq + %+ map:dct + three + crip + (from-list [[1 'one'] [2 'two'] [3 'three'] ~]) + "map" +:: +++ test-map-with-key + %^ expect-eq + %+ map-with-key + three + |=({a/@u b/tape} (weld (scow %ud a) b)) + (from-list [[1 "1one"] [2 "2two"] [3 "3three"] ~]) + "map-with-key" +:: +++ test-map-fold + %^ expect-eq + %^ map-fold + three + "Everything: " + |= {accumulator/tape value/tape} + [(weld accumulator value) (weld value "X")] + :- "Everything: twoonethree" + (from-list [[1 "oneX"] [2 "twoX"] [3 "threeX"] ~]) + "map-fold" +:: +++ test-map-keys + %^ expect-eq + %+ map-keys + three + |= a/@u + (add a 10) + (from-list [[11 "one"] [12 "two"] [13 "three"] ~]) + "map-keys" +:: +++ test-map-keys-with + %^ expect-eq + %^ map-keys-with + three + |=(a/@u 42) + weld + (from-list [[42 "twothreeone"] ~]) + "map-keys-with" +:: +++ test-fold + %^ expect-eq + %^ fold + three + "Everything: " + :: todo: this works but replacing with just ++weld causes an out of loom. + |= {accumulator/tape value/tape} + ^- tape + (weld accumulator value) + "Everything: twoonethree" + "map-fold" +:: +++ test-fold-with-keys + %^ expect-eq + %^ fold-with-keys + three + "Everything: " + |= {accumulator/tape key/@u value/tape} + ^- tape + :(weld accumulator (scow %ud key) value) + "Everything: 2two1one3three" + "map-fold-with-keys" +:: +++ test-elems + %^ expect-eq + (elems three) + ["two" "three" "one" ~] + "elems" +:: +++ test-keys + %^ expect-eq + (keys three) + [2 3 1 ~] + "keys" +:: +++ test-keys-set + %^ expect-eq + (keys-set three) + (si:nl [2 3 1 ~]) + "keys-set" +:: +++ test-from-set + %^ expect-eq + %+ from-set + (si:nl [1 2 3 ~]) + |= a/@u + (scow %ud a) + (from-list [[1 "1"] [2 "2"] [3 "3"] ~]) + "from-set" +:: +++ test-from-list-with + %^ expect-eq + %+ from-list-with + [[1 1] [2 1] [2 1] [3 3] ~] + add + (from-list [[1 1] [2 2] [3 3] ~]) + "from-list-with" +:: +++ test-filter + %^ expect-eq + %+ filter + (from-list [[1 1] [2 1] [3 2] [4 1] ~]) + |=(a/@u !=(a 1)) + (from-list [[1 1] [2 1] [4 1] ~]) + "filter" +:: +++ test-filter-with-key + %^ expect-eq + %+ filter-with-key + (from-list [[1 1] [2 1] [3 2] [4 1] ~]) + |=({a/@u b/@u} =(a 2)) + (from-list [[1 1] [3 2] [4 1] ~]) + "filter-with-key" +:: +++ test-restrict-keys + %^ expect-eq + %+ restrict-keys + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + (si:nl [1 3 5 ~]) + (from-list [[1 1] [3 3] [5 5] ~]) + "restrict-keys" +:: +++ test-without-keys + %^ expect-eq + %+ without-keys + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + (si:nl [1 3 5 ~]) + (from-list [[2 2] [4 4] ~]) + "restrict-keys" +:: +++ test-partition + %^ expect-eq + %+ partition + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=(a/@u |(=(a 1) =(a 3))) + :- (from-list [[1 1] [3 3] ~]) + (from-list [[2 2] [4 4] [5 5] ~]) + "partition" +:: +++ test-map-maybe + %^ expect-eq + %+ map-maybe + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=(a/@u ?:(=(a 3) ~ `a)) + (from-list [[1 1] [2 2] [4 4] [5 5] ~]) + "map-maybe" +:: +++ test-map-maybe-with-key + %^ expect-eq + %+ map-maybe-with-key + (from-list [[1 2] [2 3] [3 4] [4 5] [5 6] ~]) + |=({k/@u v/@u} ?:(=(k 3) ~ `v)) + (from-list [[1 2] [2 3] [4 5] [5 6] ~]) + "map-maybe-with-key" +:: +++ test-map-either + %^ expect-eq + %+ map-either + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |= value/@u + ?: =(0 (mod value 2)) + [%& "even"] + [%| 1] + :- (from-list [[2 "even"] [4 "even"] ~]) + (from-list [[1 1] [3 1] [5 1] ~]) + "map-either" +:: +++ test-map-either-with-key + %^ expect-eq + %+ map-either-with-key + (from-list [[1 1] [2 1] [3 1] [4 1] [5 1] ~]) + |= {key/@u value/@u} + ?: =(0 (mod key 2)) + [%& "even"] + [%| 1] + :- (from-list [[2 "even"] [4 "even"] ~]) + (from-list [[1 1] [3 1] [5 1] ~]) + "map-either" +:: +++ test-is-subdict + %^ expect-eq + %^ is-subdict-by + (from-list [[1 1] [4 4] ~]) + (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] ~]) + |=({a/* b/*} =(a b)) + %.y + "is-subdict" +:: +++ test-valid + %^ expect-eq + (valid (from-list [[1 1] [2 2] [3 3] [4 4] [5 5] [6 6] [7 7] [8 8] [9 9] ~])) + %.y + "valid" +-- + diff --git a/tests/new-hoon/myb.hoon b/tests/new-hoon/myb.hoon new file mode 100644 index 000000000..90ce805a3 --- /dev/null +++ b/tests/new-hoon/myb.hoon @@ -0,0 +1,32 @@ +/+ new-hoon, tester +=, myb:new-hoon +|_ tester-type:tester +++ test-from-list-null + (expect-eq (from-list ~) ~ "from-list") +:: +++ test-from-list-real + (expect-eq (from-list [5 ~]) [~ 5] "from-list") +:: +++ test-to-list-null + (expect-eq (to-list ~) ~ "to-list") +:: +++ test-to-list-real + (expect-eq (to-list [~ 5]) [5 ~] "to-list") +:: +++ test-concat-null + (expect-eq (concat ~) ~ "concat") +:: +++ test-concat-real + :: wait, if i pull the cast out from below, the concat implementation + :: doesn't compile anymore? + (expect-eq (concat `(list (maybe @ud))`[~ [~ 1] ~ [~ 2] ~]) [1 2 ~] "concat") +:: +++ test-map + %^ expect-eq + %+ map:myb + [1 2 3 2 ~] + |=(a/@u ?:(=(2 a) [~ 2] ~)) + [2 2 ~] + "map" +-- + diff --git a/tests/new-hoon/thr.hoon b/tests/new-hoon/thr.hoon new file mode 100644 index 000000000..a17cf67a9 --- /dev/null +++ b/tests/new-hoon/thr.hoon @@ -0,0 +1,32 @@ +:: tests for the either core. +/+ new-hoon, tester +=, thr:new-hoon +=/ data/(list (either @u tape)) [[%& 1] [%| "one"] [%& 2] [%| "two"] ~] +|_ tester-type:tester +++ test-apply + %^ expect-eq + %^ apply + `(either @u tape)`[%| "one"] + |=(a/@u "left") + |=(b/tape "right") + "right" + "apply" +:: +++ test-firsts + %^ expect-eq + (firsts data) + [1 2 ~] + "firsts" +:: +++ test-seconds + %^ expect-eq + (seconds data) + ["one" "two" ~] + "seconds" +:: +++ test-partition + %^ expect-eq + (partition data) + [[1 2 ~] ["one" "two" ~]] + "partition" +-- diff --git a/web/talk/main.css b/web/talk/main.css index 3366239f2..13eed6635 100644 --- a/web/talk/main.css +++ b/web/talk/main.css @@ -79,6 +79,17 @@ div.gram.same:hover div.meta { position: absolute; z-index: 1; margin-left: 1.875rem; } + .speech .fat { + max-height: 0; + transition: max-height .1s ease-in-out; + overflow: hidden; } + .speech .fat pre { + color: #fff; } + .speech:hover .fat { + max-height: 16rem; + overflow: scroll; + background-color: #000; + color: #fff; } .exp { font-family: 'scp'; @@ -90,17 +101,6 @@ div.gram.same:hover div.meta { color: #fff; background-color: #000; padding: .3rem; } - .exp .fat { - max-height: 0; - transition: max-height .1s ease-in-out; - overflow: hidden; } - .exp .fat pre { - color: #fff; } - .exp:hover .fat { - max-height: 16rem; - overflow: scroll; - background-color: #000; - color: #fff; } .comment .speech a.btn { background-color: transparent; diff --git a/web/talk/main.js b/web/talk/main.js index f1a451d04..47a8a8b2a 100644 --- a/web/talk/main.js +++ b/web/talk/main.js @@ -363,6 +363,7 @@ module.exports = recl({ key: "speech" }, url); case !exp: + exp.res = exp.res || ["evaluating..."]; return div({}, exp.exp, div({ className: "fat" }, pre({}, exp.res.join("\n")))); @@ -865,7 +866,7 @@ module.exports = recl({ return indexOf.call(src, s) < 0 && indexOf.call(s, "/") >= 0 && s[0] === "~" && s.length >= 5; }, onKeyUp: function(e) { - var $input, v; + var $input, d, v; $('.menu.depth-1 .add').removeClass('valid-false'); if (e.keyCode === 13) { $input = $(e.target); @@ -874,6 +875,8 @@ module.exports = recl({ v = "~" + v; } if (this.validateSource(v)) { + d = new Date(new Date() - 24 * 3600 * 1000); + v = v + "/" + window.urb.util.toDate(d); StationActions.addSources(this.state.station, [v]); $input.val(''); return $input.blur(); @@ -1212,7 +1215,7 @@ module.exports = recl({ return; } if (this.props['audience-lock'] != null) { - audi = _.union(audi, ["~" + window.urb.ship + "/" + this.props.station]); + audi = ["~" + window.urb.ship + "/" + this.props.station]; } audi = this.addCC(audi); txt = this.$message.text().trim().replace(/\xa0/g, ' '); @@ -1351,6 +1354,9 @@ module.exports = recl({ if (valid === true) { stan = $('#audience .input').text() || util.mainStationPath(window.urb.user); stan = (stan.split(/\ +/)).map(function(v) { + if (v.indexOf("/") === -1) { + v = v + "/inbox"; + } if (v[0] === "~") { return v; } else { @@ -1542,18 +1548,12 @@ TreeActions.registerComponent("talk-station", StationComponent); },{"./actions/StationActions.coffee":2,"./components/MessageListComponent.coffee":6,"./components/StationComponent.coffee":7,"./components/WritingComponent.coffee":8,"./util.coffee":15}],11:[function(require,module,exports){ -var send, util; +var util; util = require('../util.coffee'); window.urb.appl = "hall"; -send = function(data, cb) { - return window.urb.send(data, { - mark: "hall-action" - }, cb); -}; - module.exports = function(arg) { var MessageActions; MessageActions = arg.MessageActions; @@ -1624,15 +1624,31 @@ module.exports = function(arg) { }); }, sendMessage: function(message, cb) { - return send({ - convey: [message] - }, function(err, res) { - console.log('sent'); - console.log(arguments); - if (cb) { - return cb(err, res); - } - }); + if (window.urb.user === window.urb.ship) { + return window.urb.send({ + convey: [message] + }, { + mark: "hall-action" + }, function(err, res) { + console.log('sent local'); + console.log(arguments); + if (cb) { + return cb(err, res); + } + }); + } else { + return window.urb.send({ + publish: [message] + }, { + mark: "hall-command" + }, function(err, res) { + console.log('sent remote'); + console.log(arguments); + if (cb) { + return cb(err, res); + } + }); + } } }; }; diff --git a/web/testing.umd b/web/testing.umd new file mode 100644 index 000000000..064c95dca --- /dev/null +++ b/web/testing.umd @@ -0,0 +1,58 @@ +:- ~[comments+&] +;> + +# Writing Unit Tests + +Urbit comes with a built in system for writing tests. Like hoon files with a +certain shape go in `%/app` or `%/gen` or `%/mar`, hoon files with a certain +shape can go in `%/tests` and then are exposed to a system wide test runner. + +Say you put a test suite in `%/tests/new-hoon/thr.hoon`: + +``` +> +ls %/tests +new-hoon/ +> +ls %/tests/new-hoon +ls/hoon mp/hoon myb/hoon thr/hoon +``` + +You can then just run that individual test suite (and not the ones that are beside it in the `%/tests/new-hoon` directory) with: + +``` +> +tests /new-hoon/thr +/new-hoon/thr/test-seconds OK +/new-hoon/thr/test-partition OK +/new-hoon/thr/test-firsts OK +/new-hoon/thr/test-apply OK +``` + +## The test file + +So what is the structure of these test files? They contain a door, with arms starting with `++test-` or `++check-`. At minimum: + +``` +/+ tester +|_ tester-type:tester +++ test-some-test + (expect-eq 4 4 "trivial") +-- +``` + +All of the utilities you need to write tests are in the tester library. Also, like other hoon files, you can stack cores for models and utility functions with only the final core being inspected for test arms. + +## Some Details + +So internally, how does this work? + +The `+test` generator depends on each file/directory in `%/tests/` through a renderer. Each node in the filesystem tree is rendered by `%/ren/test-tree.hoon`, which calls itself recursively for subdirectories. + +This means all compiling of test cases happens inside ford, which can cache work and not recompile tests whose dependencies haven't changed. At runtime, all the `+test` generator does is filter and execute tests from the tree. + +I would like to get to a place where any direct scrying of the filesystem is discouraged, and almost everything flows through the functional reactive build system. This is what it is here for. + +### Future distribution of hoon libraries + +Implicit in having a standard way to write tests and a standard `+test` runner is the idea that all functionality on the current desk should be tested. + +Let's say I'm shipping a program on Urbit and I use multiple third-party libraries. Each of those libraries should have their own test suites placed in `%/tests/`. When I `|merge` their desks into my application desk, having a standard test runner means that all their tests and all my application tests get run. If you're depending on a library, you want to make sure that the tests for your dependencies run when you test your application. +