Merge branch 'master' into mtime

This commit is contained in:
Anton Dyudin 2018-02-26 17:10:20 -08:00
commit dfe5b625a4
55 changed files with 5461 additions and 1358 deletions

View File

@ -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

View File

@ -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)->

View File

@ -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

View File

@ -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)->

View File

@ -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)}" ""]]
--

View File

@ -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 {<p.hit>}"
%+ weld
(turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}"))

View File

@ -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))))
[~ +>]
--

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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 ~]]

285
gen/capitalize.hoon Normal file
View File

@ -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)

10
gen/hood/private.hoon Normal file
View File

@ -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

10
gen/hood/public.hoon Normal file
View File

@ -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

View File

@ -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]

View File

@ -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]

View File

@ -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]

71
gen/test.hoon Normal file
View File

@ -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)

View File

@ -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]]

View File

@ -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

View File

@ -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

View File

@ -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
==

View File

@ -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

View File

@ -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)

View File

@ -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 ~]] ~ ~]]
--

View File

@ -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))}

1557
lib/new-hoon.hoon Normal file

File diff suppressed because it is too large Load Diff

View File

@ -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 !.

165
lib/tester.hoon Normal file
View File

@ -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
--
--

View File

@ -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
==

11
mar/gh/commit.hoon Normal file
View File

@ -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
--
--

View File

@ -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
|%

11
mar/gh/repository.hoon Normal file
View File

@ -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
--
--

View File

@ -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)]
::

View File

@ -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
==
--
--

79
mar/unicode-data.hoon Normal file
View File

@ -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
--

10
ren/test-tree.hoon Normal file
View File

@ -0,0 +1,10 @@
/+ tester
/= base /| /!noun/
/~ ~
==
/= recur /^ (map @ta tests:tester)
/| /_ /test-tree/
/~ ~
==
::
(merge-base-and-recur:tester !>(base) recur)

View File

@ -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

View File

@ -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
== ::
--

150
sur/unicode-data.hoon Normal file
View File

@ -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)
--

View File

@ -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

View File

@ -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

File diff suppressed because it is too large Load Diff

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

280
tests/new-hoon/ls.hoon Normal file
View File

@ -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"
--

360
tests/new-hoon/mp.hoon Normal file
View File

@ -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"
--

32
tests/new-hoon/myb.hoon Normal file
View File

@ -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"
--

32
tests/new-hoon/thr.hoon Normal file
View File

@ -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"
--

View File

@ -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;

View File

@ -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);
}
});
}
}
};
};

58
web/testing.umd Normal file
View File

@ -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.