urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-28 05:22:27 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'release/next-sys' into jb/m/behn-scry

Browse Source
This commit is contained in:
Fang 2020-07-22 02:02:05 +02:00
commit 3eab480de7
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
325 changed files with 11306 additions and 24911 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
MAINTAINERS.md
View File

@ -119,7 +119,7 @@ the network.
Take [this PR][1], as an example. This constituted a great hotfix. It's a
single commit, targeting a problem that existed on the network at the time.
Here's it should be released and deployed OTA.
Here's how it should be released and deployed OTA.
[1]: https://github.com/urbit/urbit/pull/2025
@ -159,15 +159,31 @@ so that I can type e.g. `git mu origin/foo 1337`.
### Prepare a release commit
You should create Landscape or alternative pill builds, if or as appropriate
(i.e., if anything in Landscape changed -- don't trust any compiled JS/CSS
that's included in the commit), and commit these in a release commit.
You should always create a solid pill, in particular, as it's convenient for
tooling to be able to boot directly from a given release.
If you're making a Vere release, just play it safe and update all the pills.
For an Urbit OS release, after all the merge commits, make a release with the
commit message "release: urbit-os-v1.0.xx". This commit should have up-to-date
artifacts from pkg/interface and a new solid pill. If neither the pill nor the
JS need to be updated (e.g if the pill was already updated in the previous merge
commit), consider making the release commit with --allow-empty.
If anything in `pkg/interface` has changed, ensure it has been built and
deployed properly. You'll want to do this before making a pill, since you want
the pill to have the new files/hash. For most things, it is sufficient to run
`npm install; npm run build:prod` in `pkg/interface`.
However, if you've made a change to Landscape's JS, then you will need to build
a "glob" and upload it to bootstrap.urbit.org. To do this, run `npm install;
npm run build:prod` in `pkg/interface`, and add the resulting
`pkg/arvo/app/landscape/index.js` to a fakezod at that path (or just create a
new fakezod with `urbit -F zod -B bin/solid.pill -A pkg/arvo`). Run
`:glob|make`, and this will output a file in `fakezod/.urb/put/glob-0vXXX.glob`.
Upload this file to bootstrap.urbit.org, and modify `+hash` at the top of
`pkg/arvo/app/glob.hoon` to match the hash in the filename. Do not commit the
produced `index.js` and make sure it doesn't end up in your pills (they should
be less than 10MB each).
### Tag the resulting commit
What you should do here depends on the type of release being made.
@ -205,7 +221,7 @@ You can get the "contributions" section by the shortlog between the
last release and this release:
```
git log --pretty=short LAST_RELEASE.. | git shortlog
git shortlog LAST_RELEASE..
```
I originally tried to curate this list somewhat, but now just paste it

2
README.md
View File

@ -31,7 +31,7 @@ Urbit uses [Nix][nix] to manage builds. On Linux and macOS you can install Nix
via:
```
curl https://nixos.org/nix/install | sh
curl -L https://nixos.org/nix/install | sh
```
The Makefile in the project's root directory contains useful phony targets for

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:29a948ebcf5d82577b3d1271cb8d0c6cf1fa8b63a324ad2ef43e73ad5dcfe62c
size 4846052
oid sha256:f738f60e9e028081864f317106f623d2f21a5fe5c2f6fdd83576e22d21a8c6a6
size 14862847

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:6c9cec5d3dd639a82b1b867375225e6becb9f234338ef0a4cb2626ae72ba8944
size 1265620
oid sha256:9fbfbe75a6685df444621ebd27677716fd0abf7113020f3274c3b5c209e3616e
size 1304972

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:f41c00b072d8b4a8e18908b038f65602e698b92d02846f44d463c4f3d425680c
size 7313574
oid sha256:463039d83a55c7a560101bda1614a6501ef8b0cc91144588cb372f36d1b42486
size 6259468

3
nix/ops/boot-ship.nix
View File

@ -10,9 +10,10 @@ let
tlon = import ../pkgs { inherit pkgs; };
arvo = tlon.arvo;
urbit = tlon.urbit;
herb = tlon.herb;
in
import ./fakeship {
inherit pkgs tlon deps arvo pill ship debug;
inherit pkgs arvo pill ship herb urbit;
}

65
nix/ops/test/builder.sh
View File

@ -22,50 +22,59 @@ trap shutdown EXIT
herb ./ship -p hood -d '+hood/mass'
# Start the test app
# Run the unit tests and then print scrollback
herb ./ship -d '~& ~ ~& %test-unit-start ~'
herb ./ship -d '####-test %/tests'
herb ./ship -d '~& ~ ~& %test-unit-end ~'
# Start and run the test app
herb ./ship -p hood -d '+hood/start %test'
# Run the %cores tests
herb ./ship -d '~& ~ ~& %start-test-cores ~'
herb ./ship -p test -d ':- %cores /'
herb ./ship -d '~& %finish-test-cores ~'
herb ./ship -d '~& ~ ~& %test-agents-start ~'
herb ./ship -p test -d '%agents'
herb ./ship -d '~& ~ ~& %test-agents-end ~'
herb ./ship -d '~& ~ ~& %test-generators-start ~'
herb ./ship -p test -d '%generators'
herb ./ship -d '~& ~ ~& %test-generators-end ~'
herb ./ship -d '~& ~ ~& %test-marks-start ~'
herb ./ship -p test -d '%marks'
herb ./ship -d '~& ~ ~& %test-marks-end ~'
# compact the loom, comparing memory use before and after
herb ./ship -p hood -d '+hood/mass'
# Run the %renders tests
herb ./ship -d '~& ~ ~& %start-test-renders ~'
herb ./ship -p test -d ':- %renders /'
herb ./ship -d '~& %finish-test-renders ~'
# Run the test generator
herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' > test-generator-output
cat test-generator-output || true
herb ./ship -p hood -d '+hood/mass'
herb ./ship -d '~& ~ ~& %start-pack ~'
herb ./ship -d '~& ~ ~& %pack-start ~'
herb ./ship -p hood -d '+hood/pack'
herb ./ship -d '~& ~ ~& %finish-pack ~'
herb ./ship -d '~& ~ ~& %pack-end ~'
herb ./ship -p hood -d '+hood/mass'
shutdown
# Collect output
cp urbit-output test-cores-output
cp urbit-output test-renders-output
cp urbit-output test-output-unit
cp urbit-output test-output-agents
cp urbit-output test-output-generators
cp urbit-output test-output-marks
rm urbit-output
sed -i '0,/start-test-renders/d' test-renders-output
sed -i '/finish-test-renders/,$d' test-renders-output
sed -i '0,/test-unit-start/d' test-output-unit
sed -i '/test-unit-end/,$d' test-output-unit
sed -i '0,/start-test-cores/d' test-cores-output
sed -i '/finish-test-cores/,$d' test-cores-output
sed -i '0,/test-agents-start/d' test-output-agents
sed -i '/test-agents-end/,$d' test-output-agents
sed -i '0,/test-generators-start/d' test-output-generators
sed -i '/test-generators-end/,$d' test-output-generators
sed -i '0,/test-marks-start/d' test-output-marks
sed -i '/test-marks-end/,$d' test-output-marks
mkdir $out
cp test-renders-output $out/renders
cp test-cores-output $out/cores
cp test-generator-output $out/generator
cp -r test-output-* $out/
set +x

9
pkg/arvo/app/aqua.hoon
View File

@ -163,7 +163,9 @@
$
=. snap +.p.poke-result
=. ..abet-pe (publish-event tym ue)
=. ..abet-pe (handle-effects ((list ovum) -.p.poke-result))
=. ..abet-pe
~| ova=-.p.poke-result
(handle-effects ;;((list ovum) -.p.poke-result))
$
::
:: Peek
@ -380,13 +382,12 @@
%c %clay
%d %dill
%e %eyre
%f %ford
%g %gall
%j %jael
%g %gall
==
=/ pax
/(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/[vane]
/(scot %p our.hid)/work/(scot %da now.hid)/sys/vane/[vane]
=/ txt .^(@ %cx (weld pax /hoon))
[/vane/[vane] [%veer v pax txt]]
=> .(this ^+(this this))
@ -400,7 +401,7 @@
:_ ~
%- unix-event
%- %*(. file-ovum:pill-lib directories slim-dirs)
/(scot %p our.hid)/home/(scot %da now.hid)
/(scot %p our.hid)/work/(scot %da now.hid)
=^ ms all-state (poke-pill pil)
(emit-cards ms)
::

29
pkg/arvo/app/chat-cli.hoon
View File

@ -451,6 +451,7 @@
::
++ parser
|^
%+ stag |
%+ knee *command |. ~+
=- ;~(pose ;~(pfix mic -) message)
;~ pose
@ -646,24 +647,24 @@
++ tab-list
^- (list [@t tank])
:~
[%join leaf+";join ~ship/chat-name (glyph)"]
[%leave leaf+";leave ~ship/chat-name"]
[';join' leaf+";join ~ship/chat-name (glyph)"]
[';leave' leaf+";leave ~ship/chat-name"]
::
[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
[';create' leaf+";create [type] /chat-name (glyph)"]
[';delete' leaf+";delete /chat-name"]
[';invite' leaf+";invite /chat-name ~ships"]
[';banish' leaf+";banish /chat-name ~ships"]
::
[%bind leaf+";bind [glyph] ~ship/chat-name"]
[%unbind leaf+";unbind [glyph]"]
[%what leaf+";what (~ship/chat-name) (glyph)"]
[';bind' leaf+";bind [glyph] ~ship/chat-name"]
[';unbind' leaf+";unbind [glyph]"]
[';what' leaf+";what (~ship/chat-name) (glyph)"]
::
[%settings leaf+";settings"]
[%set leaf+";set key (value)"]
[%unset leaf+";unset key"]
[';settings' leaf+";settings"]
[';set' leaf+";set key (value)"]
[';unset' leaf+";unset key"]
::
[%chats leaf+";chats"]
[%help leaf+";help"]
[';chats' leaf+";chats"]
[';help' leaf+";help"]
==
:: +work: run user command
::

64
pkg/arvo/app/chat-hook.hoon
View File

@ -14,11 +14,17 @@
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-2
$: %2
state-base
==
::
+$ state-1
$: %1
loaded-cards=(list card)
loaded-cards=*
state-base
==
+$ state-0 [%0 state-base]
@ -39,7 +45,7 @@
$% [%chat-update update:store]
==
--
=| state-1
=| state-2
=* state -
::
%- agent:dbug
@ -66,29 +72,30 @@
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
:_ this(state old)
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
=/ upgraded-state
%* . *state-1
synced synced
invite-created invite-created
allow-history allow-history
loaded-cards
%- zing
^- (list (list card))
%+ turn ~(tap in keys) generate-cards
==
:_ this(state upgraded-state)
loaded-cards.upgraded-state
=^ moves state
^- (quip card state-2)
?: ?=(%2 -.old)
^- (quip card state-2)
`old
::
?: ?=(%1 -.old)
^- (quip card state-2)
:_ [%2 +>.old]
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
^- (quip card state-2)
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
:_ [%2 +.old]
%- zing
^- (list (list card))
(turn ~(tap in keys) generate-cards)
[moves this]
::
++ generate-cards
|= old-chat=path
@ -234,10 +241,7 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun
?: =(%store-load q.vase)
[loaded-cards.state state(loaded-cards ~)]
[~ state]
%noun [~ state]
::
%chat-hook-action
(poke-chat-hook-action:cc !<(action:hook vase))
@ -459,7 +463,7 @@
(chats-of-group pax)
|= chat=path
^- (list card)
=/ owner (~(get by synced) chat)
=/ owner (~(get by synced.state) chat)
?~ owner ~
?. =(u.owner our.bol) ~
%- zing

67
pkg/arvo/app/chat-store.hoon
View File

@ -5,17 +5,20 @@
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
state-one
state-two
$% state-0
state-1
state-2
==
::
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ admin-action
$% [%trim ~]
==
--
::
=| state-two
=| state-2
=* state -
::
%- agent:dbug
@ -33,15 +36,24 @@
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
?: ?=(%2 -.old)
[~ this(state old)]
=/ reversed-inbox=inbox:store
%- ~(run by inbox.old)
=? old ?=(%0 -.old)
(old-to-2 inbox.old)
=? old ?=(%1 -.old)
(old-to-2 inbox.old)
[~ this(state [%2 inbox.old])]
::
++ old-to-2
|= =inbox:store
^- state-2
:- %2
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
[~ this(state [%2 reversed-inbox])]
--
::
++ on-poke
~/ %chat-store-poke
@ -52,6 +64,7 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun [~ (poke-noun:cc !<(admin-action vase))]
==
[cards this]
::
@ -148,6 +161,32 @@
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
==
::
++ poke-noun
|= nou=admin-action
^- _state
~& %trimming-chat-store
%_ state
inbox
%- ~(urn by inbox)
|= [=path mailbox:store]
^- mailbox:store
=/ [a=* out=(list envelope:store)]
%+ roll envelopes
|= $: =envelope:store
o=[[hav=(set serial:store) curr=@] out=(list envelope:store)]
==
?: (~(has in hav.o) uid.envelope)
[[hav.o curr.o] out.o]
:-
^- [(set serial:store) @]
[(~(put in hav.o) uid.envelope) +(curr.o)]
^- (list envelope:store)
[envelope(number curr.o) out.o]
=/ len (lent out)
~? !=(len (lent envelopes)) [path [%old (lent envelopes)] [%new len]]
[[len len] (flop out)]
==
::
++ poke-json
|= jon=json
^- (quip card _state)
@ -197,8 +236,8 @@
[~ state]
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:- (send-diff path.action action(envelope envelope))
state(inbox (~(put by inbox) path.action u.mailbox))
:_ state(inbox (~(put by inbox) path.action u.mailbox))
(send-diff path.action action(envelope envelope))
::
++ handle-messages
|= act=action:store

37
pkg/arvo/app/chat-view.hoon
View File

@ -1,19 +1,19 @@
:: chat-view: sets up chat JS client, paginates data, and combines commands
:: into semantic actions for the UI
::
/- *permission-store,
*permission-hook,
*group-store,
*invite-store,
*metadata-store,
*permission-group-hook,
*chat-hook,
*metadata-hook,
*rw-security,
hook=chat-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view
/- *permission-store
/- *permission-hook
/- *group-store
/- *invite-store
/- *metadata-store
/- *permission-group-hook
/- *chat-hook
/- *metadata-hook
/- *rw-security
/- hook=chat-hook
/+ *server, default-agent, verb, dbug
/+ store=chat-store
/+ view=chat-view
::
~% %chat-view-top ..is ~
|%
@ -96,7 +96,9 @@
++ truncated-inbox
^- inbox:store
=/ =inbox:store
.^(inbox:store %gx /=chat-store/(scot %da now.bol)/all/noun)
=/ our (scot %p our.bol)
=/ now (scot %da now.bol)
.^(inbox:store %gx /[our]/chat-store/[now]/all/noun)
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
@ -403,7 +405,12 @@
++ chat-scry
|= pax=path
^- (unit mailbox:store)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
=. pax
;: weld
/(scot %p our.bol)/chat-store/(scot %da now.bol)/mailbox
pax
/noun
==
.^((unit mailbox:store) %gx pax)
::
++ maybe-group-from-chat

18
pkg/arvo/app/contact-hook.hoon
View File

@ -456,20 +456,30 @@
++ contacts-scry
|= pax=path
^- (unit contacts)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contacts pax /noun)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contacts
pax
/noun
==
.^((unit contacts) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax
/=invite-store/(scot %da now.bol)/invite/contacts/(scot %uv uid)/noun
;: weld
/(scot %p our.bol)/invite-store/(scot %da now.bol)
/invite/contacts/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
.^ (unit group)
%gx
;:(weld /(scot %p our.bol)/group-store/(scot %da now.bol) pax /noun)
==
::
++ pull-wire
|= pax=path

26
pkg/arvo/app/contact-view.hoon
View File

@ -1,14 +1,15 @@
:: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/- *group-store,
*group-hook,
*invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
*permission-group-hook,
*permission-hook
/- *group-store
/- *group-hook
/- *invite-store
/- *contact-hook
/- *metadata-store
/- *metadata-hook
/- *permission-group-hook
/- *permission-hook
::
/+ *server, *contact-json, default-agent, dbug
|%
+$ versioned-state
@ -256,11 +257,16 @@
::
++ all-scry
^- rolodex
.^(rolodex %gx /=contact-store/(scot %da now.bol)/all/noun)
.^(rolodex %gx /(scot %p our.bol)/contact-store/(scot %da now.bol)/all/noun)
::
++ contact-scry
|= pax=path
^- (unit contact)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contact pax /noun)
=. pax
;: weld
/(scot %p our.bol)/contact-store/(scot %da now.bol)/contact
pax
/noun
==
.^((unit contact) %gx pax)
--

5
pkg/arvo/app/dbug.hoon
View File

@ -360,12 +360,13 @@
:- %a
%+ turn
%+ sort ~(tap by sessions:auth-state:v-eyre)
|= [[@uv a=@da] [@uv b=@da]]
(gth a b)
|= [[@uv a=session:eyre] [@uv b=session:eyre]]
(gth expiry-time.a expiry-time.b)
|= [cookie=@uv session:eyre]
%- pairs
:~ 'cookie'^s+(end 3 4 (rsh 3 2 (scot %x (shax cookie))))
'expiry'^(time expiry-time)
'channels'^(numb ~(wyt in channels))
==
::
:: /eyre/channels.json

4
pkg/arvo/app/debug/index.html
View File

@ -12,8 +12,8 @@
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~debug/js/index.js"></script>
</body>

300
pkg/arvo/app/dojo.hoon
View File

@ -23,10 +23,10 @@
poy/(unit dojo-project) :: working
$: :: sur: structure imports
::
sur=(list cable:ford)
sur=(list cable:clay)
:: lib: library imports
::
lib=(list cable:ford)
lib=(list cable:clay)
==
var/(map term cage) :: variable state
old/(set term) :: used TLVs
@ -89,7 +89,7 @@
$: mad/dojo-command :: operation
num/@ud :: number of tasks
cud/(unit dojo-source) :: now solving
pux/(unit path) :: ford working
pux/(unit path) :: working
pro/(unit vase) :: prompting loop
per/(unit sole-edit) :: pending reverse
job/(map @ud dojo-build) :: problems
@ -100,6 +100,17 @@
--
=>
|%
:: TODO: move to zuse? copied from clay
::
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
++ with-faces
=| res=(unit vase)
|= vaz=(list [face=@tas =vase])
^- vase
?~ vaz (need res)
=/ faz (with-face i.vaz)
=. res `?~(res faz (slop faz u.res))
$(vaz t.vaz)
:: |parser-at: parsers for dojo expressions using :dir as working directory
::
++ parser-at
@ -177,13 +188,13 @@
::
++ parse-cables
%+ cook
|= cables=(list cable:ford)
|= cables=(list cable:clay)
:+ 0 %ex
^- hoon
::
:- %clsg
%+ turn cables
|= cable=cable:ford
|= cable=cable:clay
^- hoon
::
:+ %clhp
@ -194,7 +205,7 @@
(most ;~(plug com gaw) parse-cable)
::
++ parse-cable
%+ cook |=(a=cable:ford a)
%+ cook |=(a=cable:clay a)
;~ pose
(stag ~ ;~(pfix tar sym))
(cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym))
@ -312,23 +323,22 @@
dir
dir(r [%da now.hid])
::
++ he-disc `disc:ford`[p q]:he-beam
++ he-beak `beak`[p q r]:he-beam
++ he-rail `rail:ford`[[p q] s]:he-beam
++ he-parser (parser-at our.hid he-beam)
::
++ dy :: project work
|_ dojo-project ::
++ dy-abet +>(poy `+<) :: resolve
++ dy-amok +>(poy ~) :: terminate
++ dy-ford :: send work to ford
|= [way=wire schematic=schematic:ford]
:: +dy-sing: make a clay read request
::
++ dy-sing
|= [way=wire =care:clay =path]
^+ +>+>
?> ?=($~ pux)
:: pin all builds to :now.hid so they don't get cached forever
::
?> ?=(~ pux)
%- he-card(poy `+>+<(pux `way))
[%pass way %arvo %f %build live=%.n schematic]
=/ [=ship =desk =case:clay] he-beak
[%pass way %arvo %c %warp ship desk ~ %sing care case path]
::
++ dy-request
|= [way=wire =request:http]
@ -348,12 +358,8 @@
:: really shoud stop the thread as well
::
[%pass u.pux %agent [our.hid %spider] %leave ~]
[%pass u.pux %arvo %f %kill ~]
::
++ dy-slam :: call by ford
|= {way/wire gat/vase sam/vase}
^+ +>+>
(dy-ford way `schematic:ford`[%call [%$ %noun gat] [%$ %noun sam]])
=/ [=ship =desk =case:clay] he-beak
[%pass u.pux %arvo %c %warp ship desk ~]
::
++ dy-errd :: reject change, abet
|= {rev/(unit sole-edit) err/@u}
@ -479,7 +485,11 @@
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
~& %dy-no-prompt
(dy-diff %bel ~)
(dy-slam /dial u.pro !>(txt))
=/ res (mule |.((slam u.pro !>(txt))))
?: ?=(%| -.res)
%- (slog >%dy-done< p.res)
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
(dy-made-dial %noun p.res)
::
++ dy-cast
|* {typ/_* bun/vase}
@ -516,13 +526,13 @@
$lib
%_ .
lib
((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay)
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
==
::
$sur
%_ .
sur
((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay)
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
==
::
$dir =+ ^= pax ^- path
@ -637,7 +647,12 @@
~& %dy-edit-busy
=^ lic say (~(transmit sole say) dat)
(dy-diff %mor [%det lic] [%bel ~] ~)
(dy-slam(per `dat) /edit u.pro !>((tufa buf.say)))
=> .(per `dat)
=/ res (mule |.((slam u.pro !>((tufa buf.say)))))
?: ?=(%| -.res)
%- (slog >%dy-edit< p.res)
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
(dy-made-edit %noun p.res)
::
++ dy-type :: sole action
|= act/sole-action
@ -657,43 +672,79 @@
!>(~)
(slop (dy-vase p.i.src) $(src t.src))
::
++ dy-silk-vase |=(vax/vase [%$ %noun vax]) :: vase to silk
++ dy-silk-sources :: arglist to silk
|= src/(list dojo-source)
^- schematic:ford
[%$ %noun (dy-sore src)]
::
++ dy-silk-config :: configure
|= {cay/cage cig/dojo-config}
^- [wire schematic:ford]
++ dy-run-generator
!.
|= [cay=cage cig=dojo-config]
^+ +>+>
?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay)
::
:: naked gate
:: naked generator; takes one argument
::
?. &(?=({* ~} p.cig) ?=(~ q.cig))
~|(%one-argument !!)
:- /noun
:+ %call [%$ %noun q.cay]
[%$ %noun (dy-vase p.i.p.cig)]
::
=/ res (mule |.((slam q.cay (dy-vase p.i.p.cig))))
?: ?=(%| -.res)
:: TODO: or +dy-rash ?
(he-diff(poy ~) %tan leaf+"dojo: naked generator failure" p.res)
(dy-hand %noun p.res)
:: normal generator
::
:- ?+ -.q.q.cay ~|(%bad-gen ~_((sell (slot 2 q.cay)) !!))
$say /gent
$ask /dial
:: A normal generator takes as arguments:
:: - event args: date, entropy, beak (network location)
:: - positional arguments, as a list
:: - optional keyword arguments, as name-value pairs
::
:: The generator is a pair of a result mark and a gate.
:: TODO: test %ask generators
::
=/ wat (mule |.(!<(?(%ask %say) (slot 2 q.cay))))
?: ?=(%| -.wat)
(he-diff(poy ~) %tan leaf+"dojo: generator neither %ask nor %say" p.wat)
=- =/ res (mule -)
?: ?=(%| -.res)
(he-diff(poy ~) %tan leaf+"dojo: generator failure" p.res)
?- p.wat
%ask (dy-made-dial %noun p.res)
%say (dy-made-gent %noun p.res)
==
=+ gat=(slot 3 q.cay)
:+ %call [%$ %noun gat]
:+ [%$ %noun !>([now=now.hid eny=eny.hid bec=he-beak])]
(dy-silk-sources p.cig)
:+ %mute [%$ %noun (fall (slew 27 gat) !>(~))]
^- (list [wing schematic:ford])
%+ turn ~(tap by q.cig)
|= {a/term b/(unit dojo-source)}
^- [wing schematic:ford]
:- [a ~]
:+ %$ %noun
?~(b !>([~ ~]) (dy-vase p.u.b))
:: gat: generator gate
:: som: default gat sample
:: ven: event arguments
:: poz: positional arguments
:: kev: key-value named arguments
:: kuv: default keyword arguments
:: sam: fully populated sample
:: rog: default gat sample
::
|. ^- vase
=/ gat=vase (slot 3 q.cay)
=/ som=vase (slot 6 gat)
=/ ven=vase !>([now=now.hid eny=eny.hid bec=he-beak])
=/ poz=vase (dy-sore p.cig)
=/ kev=vase
=/ kuv=(unit vase) (slew 7 som)
?: =(~ q.cig)
(fall kuv !>(~))
=/ soz=(list [var=term vax=vase])
%~ tap by
%- ~(run by q.cig)
|=(val=(unit dojo-source) ?~(val !>([~ ~]) (dy-vase p.u.val)))
~| keyword-arg-failure+~(key by q.cig)
%+ slap
(with-faces kuv+(need kuv) rep+(with-faces soz) ~)
:+ %cncb [%kuv]~
%+ turn soz
|= [var=term *]
^- [wing hoon]
[[var]~ [%wing var %rep ~]]
::
=/ sam=vase :(slop ven poz kev)
?. (~(nest ut p.som) | p.sam)
~> %slog.1^leaf+"dojo: nest-need"
~> %slog.0^(skol p.som)
~> %slog.1^leaf+"dojo: nest-have"
~> %slog.0^(skol p.sam)
!!
(slam gat sam)
::
++ dy-made-dial :: dialog product
|= cag/cage
@ -742,51 +793,81 @@
++ dy-make :: build step
^+ +>
?> ?=(^ cud)
=+ bil=q.u.cud :: XX =*
?: ?=($ur -.bil)
(dy-request /hand `request:http`[%'GET' p.bil ~ ~])
?: ?=($te -.bil)
(dy-wool-poke p.bil q.bil)
%- dy-ford
^- [path schematic:ford]
?- -.bil
$ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil)
$dv [/hand [%core [he-disc (weld /hoon (flop p.bil))]]]
$ex [/hand (dy-mare p.bil)]
$sa [/hand [%bunt he-disc p.bil]]
$as [/hand [%cast he-disc p.bil [%$ (dy-cage p.q.bil)]]]
$do [/hand [%call (dy-mare p.bil) [%$ (dy-cage p.q.bil)]]]
$tu :- /hand
:+ %$ %noun
|- ^- vase
?~ p.bil !!
=+ hed=(dy-vase p.i.p.bil)
?~ t.p.bil hed
(slop hed $(p.bil t.p.bil))
=/ bil q.u.cud
?- -.bil
%ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~])
%te (dy-wool-poke p.bil q.bil)
%ex (dy-mere p.bil)
%dv (dy-sing hand+p.bil %a (snoc p.bil %hoon))
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa
=+ .^(=dais:clay cb+(en-beam:format he-beak /[p.bil]))
(dy-hand p.bil bunt:dais)
::
%as
=/ cag=cage (dy-cage p.q.bil)
=+ .^(=tube:clay cc+(en-beam:format he-beak /[p.bil]/[p.cag]))
(dy-hand p.bil (tube q.cag))
::
%do
=/ gat (dy-eval p.bil)
?: ?=(%| -.gat)
(he-diff(poy ~) %tan leaf+"dojo: %do create gate failed" p.gat)
=/ res (mule |.((slam q.p.gat (dy-vase p.q.bil))))
?: ?=(%| -.res)
(he-diff(poy ~) %tan leaf+"dojo: %do execute failed" p.res)
(dy-hand %noun p.res)
::
%tu
%+ dy-hand %noun
|- ^- vase
?~ p.bil !!
=/ hed (dy-vase p.i.p.bil)
?~ t.p.bil hed
(slop hed $(p.bil t.p.bil))
==
:: +dy-hoon-var: if input is a dojo variable lookup, perform it
::
++ dy-hoon-mark :: XX architect
:: If the expression is a bare reference to a Dojo variable,
:: produce that variable's value; otherwise, produce ~.
::
++ dy-hoon-var
=+ ^= ope
|= gen/hoon ^- hoon
?: ?=(?($sgld $sgbn) -.gen)
$(gen q.gen)
=+ ~(open ap gen)
?.(=(gen -) $(gen -) gen)
|= gen/hoon ^- (unit mark)
|= gen/hoon ^- (unit cage)
=. gen (ope gen)
?: ?=({$cnts {@ ~} ~} gen)
(bind (~(get by var) i.p.gen) head)
(~(get by var) i.p.gen)
~
:: +dy-mere: execute hoon and complete construction step
::
++ dy-mare :: build expression
|= gen/hoon
^- schematic:ford
=+ too=(dy-hoon-mark gen)
=- ?~(too - [%cast he-disc u.too -])
:+ %ride gen
:- [%$ he-hoon-head]
:^ %plan he-rail `coin`blob+**
`scaffold:ford`[he-rail zuse sur lib ~ ~]
++ dy-mere
|= =hoon
=/ res (dy-eval hoon)
?: ?=(%| -.res)
(he-diff(poy ~) %tan leaf+"dojo: hoon expression failed" p.res)
(dy-hand p.res)
:: +dy-eval: run hoon source against the dojo subject
::
:: TODO: use /lib and /sur imports to construct subject
::
++ dy-eval
|= =hoon
^- (each cage tang)
?^ val=(dy-hoon-var hoon)
&+u.val
!.
%- mule |.
:- %noun
=/ vaz=(list [term vase])
(turn ~(tap by var) |=([lal=term cag=cage] [lal q.cag]))
=/ sut (slop !>([our=our now=now eny=eny]:hid) !>(..zuse))
=? sut ?=(^ vaz) (slop (with-faces vaz) sut)
(slap sut hoon)
::
++ dy-step :: advance project
|= nex/@ud
@ -875,38 +956,17 @@
:- %pro
[& %$ (weld he-prow ?~(buf "> " "< "))]
::
++ he-made :: result from ford
|= $: way=wire
date=@da
$= result
$% [%complete build-result=build-result:ford]
[%incomplete =tang]
== ==
++ he-writ
|= [way=wire =riot:clay]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.result
%incomplete
(he-diff(poy ~) %tan tang.result)
::
%complete
?- -.build-result.result
::
%success
::
%. (result-to-cage:ford build-result.result)
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
{$hand ~} dy-hand:dye
{$dial ~} dy-made-dial:dye
{$gent ~} dy-made-gent:dye
{$noun ~} dy-made-noun:dye
{$edit ~} dy-made-edit:dye
==
::
%error
(he-diff(poy ~) %tan message.build-result.result)
== ==
?+ way !!
[%hand *]
?~ riot
(he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~)
(~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot))
==
::
++ he-unto :: result from agent
|= {way/wire cit/sign:agent:gall}
@ -916,7 +976,7 @@
+>
?~ p.cit
(he-diff %txt ">=")
(he-diff %tan u.p.cit)
(he-diff %tan leaf+"dojo: app poke failed" u.p.cit)
::
++ he-wool
|= [way=wire =sign:agent:gall]
@ -925,13 +985,13 @@
%poke-ack
?~ p.sign
+>.$
=. +>.$ (he-diff(poy ~) %tan u.p.sign)
=. +>.$ (he-diff(poy ~) %tan leaf+"dojo: thread poke failed" u.p.sign)
(he-card %pass /wool %agent [our.hid %spider] %leave ~)
::
%watch-ack
?~ p.sign
+>.$
(he-diff(poy ~) %tan u.p.sign)
(he-diff(poy ~) %tan leaf+"dojo: thread watch failed" u.p.sign)
::
%fact
?+ p.cage.sign ~|([%dojo-thread-bad-mark-result p.cage.sign] !!)
@ -1449,7 +1509,7 @@
=^ moves state
=< he-abet
?+ +<.sign-arvo ~|([%dojo-bad-take +<.sign-arvo] !!)
%made (he-made:he-full t.wire +>.sign-arvo)
%writ (he-writ:he-full t.wire +>.sign-arvo)
%http-response (he-http-response:he-full t.wire +>.sign-arvo)
==
[moves ..on-init]

8
pkg/arvo/app/eth-watcher.hoon
View File

@ -318,7 +318,11 @@
%watch-ack
?~ p.sign
[~ this]
%- (slog leaf+"eth-watcher couldn't start listen to thread" u.p.sign)
%- (slog leaf+"eth-watcher couldn't start listening to thread" u.p.sign)
:: TODO: kill thread that may have started, although it may not
:: have started yet since we get this response before the
:: %start-spider poke is processed
::
[~ (clear-running t.wire)]
::
%kick [~ (clear-running t.wire)]
@ -413,7 +417,7 @@
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card agent:gall)
?+ +<.sign-arvo ~|([%strange-sign-arvo -.sign-arvo] !!)
?+ +<.sign-arvo ~|([%strange-sign-arvo -.sign-arvo] !!)
%wake
?. ?=([%timer *] wire) ~& weird-wire=wire [~ this]
=* path t.wire

153
pkg/arvo/app/file-server.hoon
View File

@ -1,14 +1,14 @@
/- srv=file-server
/- srv=file-server, glob
/+ *server, default-agent, verb, dbug
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
+$ serving (map url-base=path [=content public=?])
+$ content
$% [%clay =path]
[%glob =glob:glob]
==
::
+$ serving (map url-base=path [clay-base=path public=?])
+$ state-zero
$: %0
+$ state-1
$: %1
=configuration:srv
=serving
==
@ -17,7 +17,7 @@
%+ verb |
%- agent:dbug
::
=| state-zero
=| state-1
=* state -
^- agent:gall
|_ =bowl:gall
@ -33,7 +33,7 @@
%+ turn
^- (list path)
[/ /'~landscape' ~]
|=(pax=path [pax [/app/landscape %.n]])
|=(pax=path [pax [clay+/app/landscape %.n]])
==
:~ (connect /)
(connect /'~landscape')
@ -49,7 +49,32 @@
++ on-load
|= old-vase=vase
^- (quip card _this)
[~ this(state !<(state-zero old-vase))]
|^
=+ !<(old-state=versioned-state old-vase)
=? old-state ?=(%0 -.old-state)
%= old-state
- %1
serving-0
%- ~(run by serving-0.old-state)
|= [=clay=path public=?]
^- [content ?]
[[%clay clay-path] public]
==
?> ?=(%1 -.old-state)
[~ this(state old-state)]
::
+$ versioned-state
$% state-1
state-0
==
::
+$ serving-0 (map url-base=path [=clay=path public=?])
+$ state-0
$: %0
=configuration:srv
=serving-0
==
--
::
++ on-poke
|= [=mark =vase]
@ -75,7 +100,14 @@
?: (~(has by serving) url-base)
~|("url already bound to {<(~(got by serving) url-base.act)>}" !!)
:- [%pass url-base %arvo %e %connect [~ url-base] %file-server]~
this(serving (~(put by serving) url-base [clay-base.act public.act]))
this(serving (~(put by serving) url-base clay+clay-base.act public.act))
::
%serve-glob
=* url-base url-base.act
?: (~(has by serving) url-base)
~|("url already bound to {<(~(got by serving) url-base.act)>}" !!)
:- [%pass url-base %arvo %e %connect [~ url-base] %file-server]~
this(serving (~(put by serving) url-base glob+glob.act public.act))
::
%unserve-dir
:- [%pass url-base.act %arvo %e %disconnect [~ url-base.act]]~
@ -84,9 +116,9 @@
%toggle-permission
?. (~(has by serving) url-base.act)
~|("url is not bound" !!)
=/ [clay-base=path public=?] (~(got by serving) url-base.act)
=/ [=content public=?] (~(got by serving) url-base.act)
:- ~
this(serving (~(put by serving) url-base.act [clay-base !public]))
this(serving (~(put by serving) url-base.act [content !public]))
::
%set-landscape-homepage-prefix
=. landscape-homepage-prefix.configuration prefix.act
@ -133,42 +165,67 @@
|= req-line=request-line
^- [simple-payload:http ?]
=/ pax=path (snoc site.req-line (need ext.req-line))
=/ clay-path=(unit [path ?]) (get-clay-path pax)
?~ clay-path [not-found:gen %.n]
=/ scry-path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
-.u.clay-path
=/ content=(unit [=content suffix=path public=?]) (get-content pax)
?~ content [not-found:gen %.n]
?- -.content.u.content
%clay
=/ scry-path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
(lowercase (weld path.content.u.content suffix.u.content))
==
?. .^(? %cu scry-path) [not-found:gen %.n]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ public.u.content
?+ ext.req-line not-found:gen
[~ %html] (html-response:gen file)
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
==
?. .^(? %cu scry-path) [not-found:gen %.n]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ +.u.clay-path
?+ ext.req-line not-found:gen
[~ %html] (html-response:gen file)
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
::
%glob
=/ data=(unit mime)
(~(get by glob.content.u.content) suffix.u.content)
?~ data
[not-found:gen %.n]
:_ public.u.content
=/ mime-type=@t (rsh 3 1 (crip <p.u.data>))
:: Should maybe inspect to see how long cache should hold
::
[[200 ['content-type' mime-type] max-1-da:gen ~] `q.u.data]
==
::
++ get-clay-path
++ lowercase
|= upper=(list @t)
%+ turn upper
|= word=@t
%- crip
%+ turn (rip 3 word)
|= char=@t
?. &((gte char 'A') (lte char 'Z'))
char
(add char ^~((sub 'a' 'A')))
::
++ get-content
|= pax=path
^- (unit [path ?])
=/ first-try (match-clay-path pax (~(del by serving) /))
^- (unit [content path ?])
=/ first-try (match-content-path pax (~(del by serving) /))
?^ first-try first-try
=/ root (~(get by serving) /)
?~ root ~
(match-clay-path pax (~(gas by *^serving) [[/ u.root] ~]))
(match-content-path pax (~(gas by *^serving) [[/ u.root] ~]))
::
++ match-clay-path
++ match-content-path
|= [pax=path =^serving]
^- (unit [path ?])
^- (unit [content path ?])
%- ~(rep by serving)
|= [[url-base=path clay-base=path public=?] out=(unit [path ?])]
|= [[url-base=path =content public=?] out=(unit [content path ?])]
?^ out out
=/ suf (get-suffix url-base pax)
?~ suf ~
`[(weld clay-base u.suf) public]
`[content u.suf public]
::
++ get-suffix
|= [a=path b=path]
@ -207,11 +264,33 @@
?+ +<.sign (on-arvo:def wire sign)
%bound
?: accepted.sign [~ this]
~& [dap.bowl %failed-to-bind path.binding.sign]
[~ this(serving (~(del by serving) path.binding.sign))]
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path (on-peek:def path)
[%x %clay %base %hash ~] ``hash+!>(base-hash)
==
:: stolen from +trouble
:: TODO: move to a lib?
++ base-hash
^- @uv
=+ .^ ota=(unit [=ship =desk =aeon:clay])
%gx /(scot %p our.bowl)/hood/(scot %da now.bowl)/kiln/ota/noun
==
?~ ota
*@uv
=/ parent (scot %p ship.u.ota)
=+ .^(=cass:clay %cs /[parent]/[desk.u.ota]/1/late/foo)
%^ end 3 3
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
--
++ on-agent on-agent:def
++ on-fail on-fail:def
--

187
pkg/arvo/app/glob.hoon Normal file
View File

@ -0,0 +1,187 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v2.kf979.bjv2a.i15f0.sesik.9nnot
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0
==
+$ card card:agent:gall
--
|%
++ wait-timeout
|= [=path now=@da]
^- card
[%pass [%timer path] %arvo %b %wait (add now ~m30)]
::
++ wait-start
|= now=@da
^- card
[%pass /start %arvo %b %wait now]
::
++ poke-file-server
|= [our=@p =cage]
^- card
[%pass /serving/(scot %uv hash) %agent [our %file-server] %poke cage]
::
++ poke-spider
|= [=path our=@p =cage]
^- card
[%pass [%running path] %agent [our %spider] %poke cage]
::
++ watch-spider
|= [=path our=@p =sub=path]
^- card
[%pass [%running path] %agent [our %spider] %watch sub-path]
::
++ leave-spider
|= [=path our=@p]
^- card
[%pass [%running path] %agent [our %spider] %leave ~]
--
=| state=state-0
=. hash.state hash
=/ serve-path=path /'~landscape'/js/index
^- agent:gall
%+ verb |
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
++ on-init
^- (quip card _this)
:: delay through timer to make sure %spider has started
[[(wait-start now.bowl) ~] this]
::
++ on-save !>(state)
++ on-load
|= old-state=vase
^- (quip card _this)
~& > %initting
=+ !<(old=all-states old-state)
?> ?=(%0 -.old)
?~ glob.old
on-init
?: ?=(%& -.u.glob.old)
?: =(hash.old hash.state)
`this(state old)
on-init
=/ cancel-cards
=/ args [tid.p.u.glob.old &]
:~ (leave-spider /(scot %uv hash.old) our.bowl)
(poke-spider /(scot %uv hash.old) our.bowl %spider-stop !>(args))
==
=^ init-cards this on-init
[(weld cancel-cards init-cards) this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%glob-make
:_ this
=/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl)
=+ .^(=tube:clay %cc (weld home /js/mime))
=+ .^(js=@t %cx (weld home /app/landscape/js/index/js))
=+ !<(=mime (tube !>(js)))
=/ =glob:glob (~(put by *glob:glob) /js mime)
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~
::
%noun
?: =(%kick q.vase)
(on-load !>(state(hash *@uv)))
(on-poke:def mark vase)
==
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%serving @ ~] wire)
(on-agent:def wire sign)
?: ?=([%make ~] wire)
(on-agent:def wire sign)
?. ?=([%running @ ~] wire)
%- (slog leaf+"glob: strange on-agent! {<wire -.sign>}" ~)
(on-agent:def wire sign)
?- -.sign
%poke-ack
?~ p.sign
[~ this]
%- (slog leaf+"glob: couldn't start thread; will retry" u.p.sign)
:_ this(glob.state ~) :_ ~
(leave-spider t.wire our.bowl)
::
%watch-ack
?~ p.sign
[~ this]
%- (slog leaf+"glob: couldn't listen to thread; will retry" u.p.sign)
[~ this(glob.state ~)]
::
%kick
=? glob.state ?=([~ %| *] glob.state)
~
`this
::
%fact
=/ produced-hash (slav %uv i.t.wire)
?. =(hash.state produced-hash)
[~ this]
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"glob: thread failed; will retry" leaf+<term> tang)
[~ this(glob.state ~)]
::
%thread-done
=+ !<(=glob:glob q.cage.sign)
?. =(hash.state (sham glob))
%: mean
leaf+"glob: hash doesn't match!"
>expected=hash.state<
>got=(sham glob)<
~
==
:_ this(glob.state `[%& glob]) :_ ~
%+ poke-file-server our.bowl
[%file-server-action !>([%serve-glob serve-path glob %&])]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?: ?=([%start ~] wire)
=/ new-tid=@ta (cat 3 'glob--' (scot %uv eny.bowl))
=/ args [~ `new-tid %glob !>([hash.state ~])]
=/ action !>([%unserve-dir serve-path])
:_ this(glob.state `[%| new-tid])
:~ (poke-file-server our.bowl %file-server-action action)
(wait-timeout /[new-tid] now.bowl)
(watch-spider /(scot %uv hash.state) our.bowl /thread-result/[new-tid])
(poke-spider /(scot %uv hash.state) our.bowl %spider-start !>(args))
==
?. ?=([%timer @ ~] wire)
%- (slog leaf+"glob: strange on-arvo wire: {<wire [- +<]:sign-arvo>}" ~)
`this
?. ?=(%wake +<.sign-arvo)
%- (slog leaf+"glob: strange on-arvo sign: {<wire [- +<]:sign-arvo>}" ~)
`this
?: ?=([~ %& *] glob.state)
`this
?. ?| ?=(~ glob.state)
=(i.t.wire tid.p.u.glob.state)
==
`this
?^ error.sign-arvo
%- (slog leaf+"glob: timer handling failed; will retry" ~)
[[(wait-timeout t.wire now.bowl)]~ this]
%- (slog leaf+"glob: timed out; retrying" ~)
(on-load !>(state(hash *@uv)))
::
++ on-fail on-fail:def
--

50
pkg/arvo/app/goad.hoon
View File

@ -3,30 +3,15 @@
^- agent:gall
=>
|%
++ warp
|= =bowl:gall
[%pass /clay %arvo %c %warp our.bowl %home ~ %next %z da+now.bowl /sys]
::
++ wait
|= =bowl:gall
[%pass /behn %arvo %b %wait +(now.bowl)]
::
++ goad
|= force=?
:~ [%pass /gall %arvo %g %goad force ~]
==
--
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
++ on-init
:: subscribe to /sys and do initial goad
::
[[(warp bowl) (wait bowl) ~] this]
::
++ on-save on-save:def
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
?: ?=([%noun * %go] +<)
@ -35,32 +20,19 @@
[(goad &) this]
(on-poke:def mark vase)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
?+ wire (on-arvo:def wire sign-arvo)
[%clay ~]
:: on writ, wait
::
?> ?=(%writ +<.sign-arvo)
:_ this
:~ (warp bowl)
(wait bowl)
==
::
[%behn ~]
:: on wake, goad
::
?> ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
:_ this :_ ~
[%pass /dill %arvo %d %flog %crud %goad-fail u.error.sign-arvo]
%- (slog leaf+"goad: recompiling all apps" ~)
[(goad &) this]
|= [wir=wire sin=sign-arvo]
?+ wir (on-arvo:def wir sin)
[%clay ~] `this
[%behn ~] `this :: backcompat
==
::
++ on-agent on-agent:def
++ on-fail on-fail:def
++ on-init on-init:def
++ on-leave on-leave:def
++ on-load on-load:def
++ on-peek on-peek:def
++ on-save on-save:def
++ on-watch on-watch:def
--

11
pkg/arvo/app/group-hook.hoon
View File

@ -68,7 +68,7 @@
?. (~(has by synced.state) t.path)
(on-watch:def path)
=/ scry-path=^path
:(welp /=group-store/(scot %da now.bowl) t.path /noun)
:(welp /(scot %p our.bowl)/group-store/(scot %da now.bowl) t.path /noun)
=/ grp=(unit group)
.^((unit group) %gx scry-path)
?~ grp
@ -242,8 +242,13 @@
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
.^ (unit group)
%gx
(scot %p our.bol)
%group-store
(scot %da now.bol)
(weld pax /noun)
==
::
++ update-subscribers
|= [pax=path diff=group-update]

306
pkg/arvo/app/hood.hoon
View File

@ -1,228 +1,120 @@
:: :: ::
:::: /hoon/hood/app :: ::
:: :: ::
/? 310 :: zuse version
/- *sole
/+ sole, :: libraries
:: XX these should really be separate apps, as
:: none of them interact with each other in
:: any fashion; however, to reduce boot-time
:: complexity and work around the current
:: non-functionality of end-to-end acknowledgments,
:: they have been bundled into :hood
::
:: |command handlers
hood-helm, hood-kiln, hood-drum, hood-write
:: :: ::
:::: :: ::
:: :: ::
/+ default-agent
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
++ hood-module
:: each hood module follows this general shape
=> |%
+$ part [%module %0 pith]
+$ pith ~
++ take
|~ [wire sign-arvo]
*(quip card:agent:gall part)
++ take-agent
|~ [wire gift:agent:gall]
*(quip card:agent:gall part)
++ poke
|~ [mark vase]
*(quip card:agent:gall part)
--
|= [bowl:gall own=part]
|_ moz=(list card:agent:gall)
++ abet [(flop moz) own]
--
+$ state
$: %8
drum=state:drum
helm=state:helm
kiln=state:kiln
==
+$ state-7
$: %7
drum=state:drum
helm=state:helm
kiln=state:kiln
==
+$ any-state
$% state
state-7
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
==
+$ any-state-tuple
$: drum=any-state:drum
helm=any-state:helm
kiln=any-state:kiln
==
+$ fin-any-state
$% [%drum any-state:drum]
[%helm any-state:helm]
[%kiln any-state:kiln]
[%write *] :: gets deleted
==
--
:: :: ::
:::: :: :: state handling
:: :: ::
!:
=> |% ::
++ hood-old :: unified old-state
{?($1 $2 $3 $4 $5 $6) lac/(map @tas hood-part-old)}
++ hood-1 :: unified state
{$6 lac/(map @tas hood-part)} ::
++ hood-good :: extract specific
=+ hed=$:hood-head
|@ ++ $
|: paw=$:hood-part
?- hed
$drum ?>(?=($drum -.paw) `part:hood-drum`paw)
$helm ?>(?=($helm -.paw) `part:hood-helm`paw)
$kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw)
$write ?>(?=($write -.paw) `part:hood-write`paw)
==
--
++ hood-head _-:$:hood-part :: initialize state
++ hood-make ::
=+ $:{our/@p hed/hood-head} ::
|@ ++ $
?- hed
$drum (make:hood-drum our)
$helm *part:hood-helm
$kiln *part:hood-kiln
$write *part:hood-write
==
--
++ hood-part-old hood-part :: old state for ++prep
++ hood-port :: state transition
|: paw=$:hood-part-old ^- hood-part ::
paw ::
:: ::
++ hood-part :: current module state
$% {$drum $2 pith-2:hood-drum} ::
{$helm $0 pith:hood-helm} ::
{$kiln $0 pith:hood-kiln} ::
{$write $0 pith:hood-write} ::
== ::
-- ::
:: :: ::
:::: :: :: app proper
:: :: ::
^- agent:gall
=| hood-1 :: module states
=> |%
++ help
|= hid/bowl:gall
|%
++ able :: find+make part
=+ hed=$:hood-head
|@ ++ $
=+ rep=(~(get by lac) hed)
=+ par=?^(rep u.rep `hood-part`(hood-make our.hid hed))
((hood-good hed) par)
--
::
++ ably :: save part
=+ $:{(list) hood-part}
|@ ++ $
[+<- (~(put by lac) +<+< +<+)]
--
:: :: ::
:::: :: :: generic handling
:: :: ::
++ prep
|= old/(unit hood-old) ^- (quip _!! _+>)
:- ~
?~ old +>
+>(lac (~(run by lac.u.old) hood-port))
::
++ poke-hood-load :: recover lost brain
|= dat/hood-part
?> =(our.hid src.hid)
~& loaded+-.dat
[~ (~(put by lac) -.dat dat)]
::
::
++ from-module :: create wrapper
|* _[identity=%module start=..$ finish=_abet]:(hood-module)
=- [wrap=- *start] :: usage (wrap handle-arm):from-foo
|* handle/_finish
|= a=_+<.handle
=. +>.handle (start hid (able identity))
^- (quip card:agent:gall _lac)
%- ably
^- (quip card:agent:gall hood-part)
(handle a)
:: per-module interface wrappers
++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum))
++ from-helm (from-module %helm [..$ _abet]:(hood-helm))
++ from-kiln (from-module %kiln [..$ _abet]:(hood-kiln))
++ from-write (from-module %write [..$ _abet]:(hood-write))
--
--
|_ hid/bowl:gall :: gall environment
=| =state
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
drum-core (drum bowl drum.state)
helm-core (helm bowl helm.state)
kiln-core (kiln bowl kiln.state)
::
++ on-fail on-fail:def
++ on-init
`..on-init
^- step:agent:gall
=^ d drum.state on-init:drum-core
[d this]
::
++ on-save
!>([%6 lac])
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[* %kiln *] (on-peek:kiln-core path)
==
::
++ on-save !>(state)
++ on-load
|= =old-state=vase
=/ old-state !<(hood-old old-state-vase)
=^ cards lac
=. lac lac.old-state
?- -.old-state
%1 ((wrap on-load):from-drum:(help hid) %1)
%2 ((wrap on-load):from-drum:(help hid) %2)
%3 ((wrap on-load):from-drum:(help hid) %3)
%4 ((wrap on-load):from-drum:(help hid) %4)
%5 ((wrap on-load):from-drum:(help hid) %5)
%6 `lac
^- step:agent:gall
=+ !<(old=any-state old-state-vase)
=/ tup=any-state-tuple
?+ -.old +.old
?(%1 %2 %3 %4 %5 %6)
:* =-(?>(?=(%drum -<) ->) (~(got by lac.old) %drum))
=-(?>(?=(%helm -<) ->) (~(got by lac.old) %helm))
=-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln))
==
==
[cards ..on-init]
=^ d drum.state (on-load:drum-core -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup)
[:(weld d h k) this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
=/ h (help hid)
=^ cards lac
?: =(%helm (end 3 4 mark))
((wrap poke):from-helm:h mark vase)
?: =(%drum (end 3 4 mark))
((wrap poke):from-drum:h mark vase)
?: =(%kiln (end 3 4 mark))
((wrap poke):from-kiln:h mark vase)
?: =(%write (end 3 5 mark))
((wrap poke):from-write:h mark vase)
:: XX should rename and move to libs
::
?+ mark ~|([%poke-hood-bad-mark mark] !!)
%hood-load (poke-hood-load:h !<(hood-part vase))
%atom ((wrap poke-atom):from-helm:h !<(@ vase))
%dill-belt ((wrap poke-dill-belt):from-drum:h !<(dill-belt:dill vase))
%dill-blit ((wrap poke-dill-blit):from-drum:h !<(dill-blit:dill vase))
%hood-sync ((wrap poke-sync):from-kiln:h !<([desk ship desk] vase))
==
[cards ..on-init]
^- step:agent:gall
|^
=/ fin (end 3 4 mark)
?: =(%drum fin) poke-drum
?: =(%helm fin) poke-helm
?: =(%kiln fin) poke-kiln
::
?+ mark (on-poke:def mark vase)
%atom poke-helm(mark %helm-atom)
%dill-belt poke-drum(mark %drum-dill-belt)
%dill-blit poke-drum(mark %drum-dill-blit)
%hood-sync poke-kiln(mark %kiln-sync)
%write-sec-atom poke-helm(mark %helm-write-sec-atom)
==
++ poke-drum =^(c drum.state (poke:drum-core mark vase) [c this])
++ poke-helm =^(c helm.state (poke:helm-core mark vase) [c this])
++ poke-kiln =^(c kiln.state (poke:kiln-core mark vase) [c this])
--
::
++ on-watch
|= =path
=/ h (help hid)
=^ cards lac
?+ path ~|([%hood-bad-path wire] !!)
[%drum *] ((wrap peer):from-drum:h t.path)
==
[cards ..on-init]
::
++ on-leave
|= path
`..on-init
::
++ on-peek
|= path
*(unit (unit cage))
^- step:agent:gall
?+ path (on-watch:def +<)
[%drum *] =^(c drum.state (peer:drum-core +<) [c this])
==
::
++ on-agent
|= [=wire =sign:agent:gall]
=/ h (help hid)
=^ cards lac
?+ wire ~|([%hood-bad-wire wire] !!)
[%helm *] ((wrap take-agent):from-helm:h wire sign)
[%kiln *] ((wrap take-agent):from-kiln:h wire sign)
[%drum *] ((wrap take-agent):from-drum:h wire sign)
[%write *] ((wrap take-agent):from-write:h wire sign)
==
[cards ..on-init]
^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-agent:drum-core +<) [c this])
[%helm *] =^(c helm.state (take-agent:helm-core +<) [c this])
[%kiln *] =^(c kiln.state (take-agent:kiln-core +<) [c this])
==
:: TODO: symmetry between adding and stripping wire prefixes
::
++ on-arvo
|= [=wire =sign-arvo]
=/ h (help hid)
=^ cards lac
?+ wire ~|([%hood-bad-wire wire] !!)
[%helm *] ((wrap take):from-helm:h t.wire sign-arvo)
[%drum *] ((wrap take):from-drum:h t.wire sign-arvo)
[%kiln *] ((wrap take-general):from-kiln:h t.wire sign-arvo)
[%write *] ((wrap take):from-write:h t.wire sign-arvo)
==
[cards ..on-init]
::
++ on-fail
|= [term tang]
`..on-init
|= [=wire syn=sign-arvo]
^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-arvo:drum-core t.wire syn) [c this])
[%helm *] =^(c helm.state (take-arvo:helm-core t.wire syn) [c this])
[%kiln *] =^(c kiln.state (take-arvo:kiln-core t.wire syn) [c this])
==
--

12
pkg/arvo/app/invite-hook.hoon
View File

@ -100,14 +100,22 @@
|= pax=path
^- (unit invitatory)
=. pax
;:(weld /=invite-store/(scot %da now.bowl)/invitatory pax /noun)
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invitatory
pax
/noun
==
.^((unit invitatory) %gx pax)
::
++ invite-scry
|= [pax=path uid=serial]
^- (unit invite)
=. pax
;:(weld /=invite-store/(scot %da now.bowl)/invite pax /(scot %uv uid)/noun)
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invite
pax
/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
--

17
pkg/arvo/app/invite-view.hoon Normal file
View File

@ -0,0 +1,17 @@
/+ default-agent
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
step `step:agent:gall`[~ this]
++ on-init on-init:def
++ on-save on-save:def
++ on-load on-load:def
++ on-poke |=(* step)
++ on-watch on-watch:def
++ on-leave |=(* step)
++ on-peek |=(* ~)
++ on-agent |=(* step)
++ on-arvo |=(* step)
++ on-fail on-fail:def
--

0
pkg/arvo/app/landscape/img/Chat.png → pkg/arvo/app/landscape/img/.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 4.7 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

BIN
pkg/arvo/app/landscape/img/chat.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 4.7 KiB

0
pkg/arvo/app/landscape/img/ChatSwitcherClosed.png → pkg/arvo/app/landscape/img/chatswitcherclosed.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.3 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

0
pkg/arvo/app/landscape/img/ChatSwitcherLink.png → pkg/arvo/app/landscape/img/chatswitcherlink.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.4 KiB

After

Width:  |  Height:  |  Size: 1.4 KiB

0
pkg/arvo/app/landscape/img/Chevron.png → pkg/arvo/app/landscape/img/chevron.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 453 B

After

Width:  |  Height:  |  Size: 453 B

0
pkg/arvo/app/landscape/img/CodeEval.png → pkg/arvo/app/landscape/img/codeeval.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 611 B

After

Width:  |  Height:  |  Size: 611 B

0
pkg/arvo/app/landscape/img/Dojo.png → pkg/arvo/app/landscape/img/dojo.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.2 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

0
pkg/arvo/app/landscape/img/Favicon.png → pkg/arvo/app/landscape/img/favicon.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 2.8 KiB

0
pkg/arvo/app/landscape/img/Icon-Home.png → pkg/arvo/app/landscape/img/icon-home.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 255 B

After

Width:  |  Height:  |  Size: 255 B

0
pkg/arvo/app/landscape/img/ImageUpload.png → pkg/arvo/app/landscape/img/imageupload.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 865 B

After

Width:  |  Height:  |  Size: 865 B

0
pkg/arvo/app/landscape/img/Link.png → pkg/arvo/app/landscape/img/link.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

0
pkg/arvo/app/landscape/img/Links.png → pkg/arvo/app/landscape/img/links.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 3.3 KiB

0
pkg/arvo/app/landscape/img/Publish.png → pkg/arvo/app/landscape/img/publish.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB

0
pkg/arvo/app/landscape/img/Send.png → pkg/arvo/app/landscape/img/send.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1010 B

After

Width:  |  Height:  |  Size: 1010 B

0
pkg/arvo/app/landscape/img/Spinner.png → pkg/arvo/app/landscape/img/spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

9
pkg/arvo/app/landscape/js/channel.js
View File

@ -9,6 +9,9 @@ class Channel {
this.onChannelError = (err) => {
console.error('event source error: ', err);
};
this.onChannelOpen = (e) => {
console.log('open', e);
};
}
init() {
@ -58,6 +61,10 @@ class Channel {
this.onChannelError = onError;
}
setOnChannelOpen(onOpen = (e) => {}) {
this.onChannelOpen = onOpen;
}
deleteOnUnload() {
window.addEventListener("unload", (event) => {
this.delete();
@ -216,6 +223,8 @@ class Channel {
}
}
this.eventSource.onopen = this.onChannelOpen;
this.eventSource.onerror = e => {
this.delete();
this.init();

351
pkg/arvo/app/landscape/js/index.js
View File

File diff suppressed because one or more lines are too long

94
pkg/arvo/app/language-server.hoon
View File

@ -101,7 +101,7 @@
=^ cards state
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%e %bound *] `state
[%f *] (handle-build:lsp wire +.sign-arvo)
[%c *] (handle-build:lsp wire +.sign-arvo)
==
[cards this]
::
@ -192,13 +192,10 @@
^- (quip card _state)
~& > %lsp-shutdown
:_ *state-zero
%- zing
%+ turn
~(tap in ~(key by builds))
|= uri=@t
:+ [%pass /ford/[uri] %arvo %f %kill ~]
[%pass /ford/[uri]/deps %arvo %f %kill ~]
~
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]
::
++ handle-did-close
|= [uri=@t version=(unit @)]
@ -210,10 +207,7 @@
=. builds
(~(del by builds) uri)
:_ state
:~
[%pass /ford/[uri] %arvo %f %kill ~]
[%pass /ford/[uri]/deps %arvo %f %kill ~]
==
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]~
::
++ handle-did-save
|= [uri=@t version=(unit @)]
@ -240,43 +234,25 @@
`state
::
++ handle-build
|= [=path =gift:able:ford]
|= [=path =gift:able:clay]
^- (quip card _state)
?. ?=([%made *] gift)
[~ state]
?. ?=([%complete *] result.gift)
[~ state]
?> ?=([%writ *] gift)
=/ uri=@t
(snag 1 path)
=/ =build-result:ford
build-result.result.gift
?+ build-result [~ state]
::
[%success %plan *]
=. preludes
(~(put by preludes) uri -:vase.build-result)
=; res=(quip card _state)
[(snoc -.res (build-file | uri path)) +.res]
?~ p.gift
[~ state]
::
[%success %core *]
=. builds
(~(put by builds) uri vase.build-result)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
:_ state
(give-rpc-notification (get-diagnostics uri))
::
[%error *]
=/ error-ranges=(list =range:lsp-sur)
(get-errors-from-tang:build uri message.build-result)
?~ error-ranges
[~ state]
=. ford-diagnostics
%+ ~(put by ford-diagnostics)
uri
[i.error-ranges 1 'Build Error']~
:_ state
(give-rpc-notification (get-diagnostics uri))
==
=. builds
(~(put by builds) uri q.r.u.p.gift)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
=+ .^(=open:clay %cs /(scot %p our.bow)/home/(scot %da now.bow)/open)
=/ =type -:(open (uri-to-path:build uri))
=. preludes
(~(put by preludes) uri type)
:_ state
(give-rpc-notification (get-diagnostics uri))
::
++ get-diagnostics
|= uri=@t
@ -287,20 +263,14 @@
(~(gut by ford-diagnostics) uri ~)
(get-parser-diagnostics uri)
::
++ get-build-deps
|= [=path buf=wall]
^- schematic:ford
=/ parse=(like scaffold:ford)
%+ (lsp-parser [byk.bow path]) [1 1]
(zing (join "\0a" buf))
=/ =scaffold:ford
?~ q.parse *scaffold:ford
p.u.q.parse
:* %plan
[[our.bow %home] (flop path)]
*coin
scaffold(sources `(list hoon)`~[[%cnts ~[[%& 1]] ~]])
==
++ build-file
|= [eager=? uri=@t =path]
^- card
=/ =rave:clay
?: eager
[%sing %a da+now.bow path]
[%next %a da+now.bow path]
[%pass /ford/[uri] %arvo %c %warp our.bow %home `rave]
::
++ handle-did-open
|= item=text-document-item:lsp-sur
@ -311,18 +281,10 @@
(~(put by bufs) uri.item buf)
=/ =path
(uri-to-path:build uri.item)
=/ =schematic:ford
[%core [our.bow %home] (flop path)]
=/ dep-schematic=schematic:ford
(get-build-deps path buf)
:_ state
%+ weld
(give-rpc-notification (get-diagnostics uri.item))
^- (list card)
:~
[%pass /ford/[uri.item] %arvo %f %build live=%.y schematic]
[%pass /ford/[uri.item]/deps %arvo %f %build live=%.y dep-schematic]
==
[(build-file & uri.item path) ~]
::
++ get-parser-diagnostics
|= uri=@t
@ -330,7 +292,7 @@
=/ t=tape
(zing (join "\0a" `wall`(~(got by bufs) uri)))
=/ parse
(lily:auto t (lsp-parser *beam))
(lily:auto t (lsp-parser (uri-to-path:build uri)))
?. ?=(%| -.parse)
~
=/ loc=position:lsp-sur

4
pkg/arvo/app/lens.hoon
View File

@ -1,7 +1,6 @@
/- lens, *sole
/+ base64, *server, default-agent
/= lens-mark /: /===/mar/lens/command
/!noun/
/= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube
=, format
|%
:: +lens-out: json or named octet-stream
@ -15,7 +14,6 @@
job=(unit [eyre-id=@ta com=command:lens])
==
==
::
--
::
=| =state

24
pkg/arvo/app/link-listen-hook.hoon
View File

@ -14,8 +14,8 @@
:: to expede this process, we prod other potential listeners when we add
:: them to our metadata+groups definition.
::
/- link-listen-hook, *metadata-store, *link, group-store
/+ mdl=metadata, default-agent, verb, dbug
/- *link, listen-hook=link-listen-hook, *metadata-store, group-store
/+ mdl=metadata, default-agent, verb, dbug, store=link-store
::
~% %link-listen-hook-top ..is ~
|%
@ -167,7 +167,7 @@
?> (team:title [our src]:bowl)
=^ cards state
~| p.vase
(handle-listen-action:do !<(action:link-listen-hook vase))
(handle-listen-action:do !<(action:listen-hook vase))
[cards this]
==
::
@ -218,7 +218,7 @@
:: user actions & updates
::
++ handle-listen-action
|= =action:link-listen-hook
|= =action:listen-hook
^- (quip card _state)
::NOTE no-opping where appropriate happens further down the call stack.
:: we *could* no-op here, as %watch when we're already listening should
@ -250,7 +250,7 @@
$(cards (weld cards more-cards), groups t.groups)
::
++ send-update
|= =update:link-listen-hook
|= =update:listen-hook
^- card
[%give %fact ~[/listening] %link-listen-update !>(update)]
::
@ -500,11 +500,11 @@
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-initial
%- handle-link-initial
[who.target where.target !<(initial vase)]
[who.target where.target !<(initial:store vase)]
::
%link-update
%- handle-link-update
[who.target where.target !<(update vase)]
[who.target where.target !<(update:store vase)]
==
==
::
@ -546,7 +546,7 @@
group-path
::
++ do-link-action
|= [=wire =action]
|= [=wire =action:store]
^- card
:* %pass
wire
@ -558,7 +558,7 @@
==
::
++ handle-link-initial
|= [who=ship where=path =initial]
|= [who=ship where=path =initial:store]
^- (quip card _state)
?> =(src.bowl who)
?+ -.initial ~|([dap.bowl %unexpected-initial -.initial] !!)
@ -580,7 +580,7 @@
==
::
++ handle-link-update
|= [who=ship where=path =update]
|= [who=ship where=path =update:store]
^- (quip card _state)
?> =(src.bowl who)
:_ state
@ -594,11 +594,11 @@
::
%annotations
%+ turn notes.update
|= =note
|= =^note
^- card
%+ do-link-action
[%forward %annotation (scot %p who) where]
[%read where url.update who note]
[%read where url.update `comment`[who note]]
==
::
++ take-forward-sign

6
pkg/arvo/app/link-proxy-hook.hoon
View File

@ -19,8 +19,8 @@
:: when adding support for new paths, the only things you'll likely want
:: to touch are +permitted, +initial-response, & +kick-proxies.
::
/- group-store, *metadata-store
/+ *link, metadata, default-agent, verb, dbug
/- *link, group-store, *metadata-store
/+ store=link-store, metadata, default-agent, verb, dbug
~% %link-proxy-hook-top ..is ~
|%
+$ state-0
@ -269,7 +269,7 @@
++ initial-response
|= =path
^- card
=; =initial
=; =initial:store
[%give %fact ~ %link-initial !>(initial)]
?+ path !!
[%local-pages ^]

39
pkg/arvo/app/link-store.hoon
View File

@ -50,7 +50,8 @@
:: ?
:: /seen/wood-url/some-path have we seen this here
::
/+ *link, default-agent, verb, dbug
/- *link
/+ store=link-store, default-agent, verb, dbug
::
|%
+$ state-0
@ -101,8 +102,8 @@
=^ cards state
?+ mark (on-poke:def mark vase)
::TODO move json conversion into mark once mark performance improves
%json (do-action:do (action:de-json !<(json vase)))
%link-action (do-action:do !<(action vase))
%json (do-action:do (action:dejs:store !<(json vase)))
%link-action (do-action:do !<(action:store vase))
==
[cards this]
::
@ -121,7 +122,7 @@
::
[%y ?(%annotations %discussions) *]
=/ [spath=^path surl=url]
(break-discussion-path t.t.path)
(break-discussion-path:store t.t.path)
=- ``noun+!>(-)
::
?: =(~ surl)
@ -174,22 +175,22 @@
|^ ?+ path (on-watch:def path)
[%local-pages *]
%+ give %link-initial
^- initial
^- initial:store
[%local-pages (get-local-pages:do t.path)]
::
[%submissions *]
%+ give %link-initial
^- initial
^- initial:store
[%submissions (get-submissions:do t.path)]
::
[%annotations *]
%+ give %link-initial
^- initial
^- initial:store
[%annotations (get-annotations:do t.path)]
::
[%discussions *]
%+ give %link-initial
^- initial
^- initial:store
[%discussions (get-discussions:do t.path)]
::
[%seen ~]
@ -218,7 +219,7 @@
:: writing
::
++ do-action
|= =action
|= =action:store
^- (quip card _state)
?- -.action
%save (save-page +.action)
@ -284,8 +285,8 @@
:+ %give %fact
:+ :~ /annotations
[%annotations %$ path]
[%annotations (build-discussion-path url)]
[%annotations (build-discussion-path path url)]
[%annotations (build-discussion-path:store url)]
[%annotations (build-discussion-path:store path url)]
==
%link-update
!>([%annotations path url [note]~])
@ -324,11 +325,11 @@
?: ?=(^ (find ~[submission] submissions.links))
[| submissions.links]
:- &
(submissions:merge submissions.links ~[submission])
(submissions:merge:store submissions.links ~[submission])
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
=/ =site (site-from-url url.submission)
=/ =site (site-from-url:store url.submission)
=. by-site (~(add ja by-site) site [path submission])
:: send updates to subscribers
::
@ -354,7 +355,7 @@
?: ?=(^ (find ~[comment] comments.discussion))
[| comments.discussion]
:- &
(comments:merge comments.discussion ~[comment])
(comments:merge:store comments.discussion ~[comment])
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: send updates to subscribers
@ -365,8 +366,8 @@
:+ %give %fact
:+ :~ /discussions
[%discussions '' path]
[%discussions (build-discussion-path url)]
[%discussions (build-discussion-path path url)]
[%discussions (build-discussion-path:store url)]
[%discussions (build-discussion-path:store path url)]
==
%link-update
!>([%discussions path url [comment]~])
@ -420,7 +421,7 @@
|= =path
^- ?
=/ [=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
%. url
%~ has in
seen:(~(gut by by-group) path *links)
@ -430,7 +431,7 @@
|= =path
^- (per-path-url notes)
=/ args=[=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::
@ -460,7 +461,7 @@
|= =path
^- (per-path-url comments)
=/ args=[=^path =url]
(break-discussion-path path)
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::

58
pkg/arvo/app/link-view.hoon
View File

@ -10,12 +10,12 @@
:: /json/[n]/submission/[wood-url]/[collection] nth matching submission
:: /json/seen mark-as-read updates
::
/- *link-view,
*invite-store, group-store,
link-listen-hook,
group-hook, permission-hook, permission-group-hook,
metadata-hook, contact-view
/+ *link, metadata, *server, default-agent, verb, dbug
/- *link, view=link-view
/- *invite-store, group-store
/- listen-hook=link-listen-hook
/- group-hook, permission-hook, permission-group-hook
/- metadata-hook, contact-view
/+ store=link-store, metadata, *server, default-agent, verb, dbug
~% %link-view-top ..is ~
::
|%
@ -89,10 +89,10 @@
:_ this
?+ mark (on-poke:def mark vase)
%link-action
[(handle-action:do !<(action vase)) ~]
[(handle-action:do !<(action:store vase)) ~]
::
%link-view-action
(handle-view-action:do !<(view-action vase))
(handle-view-action:do !<(action:view vase))
==
::
++ on-watch
@ -117,11 +117,11 @@
::
[%submission @ ^]
:_ this
(give-specific-submission:do p (break-discussion-path t.t.t.path))
(give-specific-submission:do p (break-discussion-path:store t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path t.t.t.path))
(give-initial-discussions:do p (break-discussion-path:store t.t.t.path))
==
::
++ on-agent
@ -145,7 +145,7 @@
::
%link-update
:_ this
:- (send-update:do !<(update vase))
:- (send-update:do !<(update:store vase))
?: =(/discussions wire) ~
~[give-tile-data:do]
==
@ -221,12 +221,12 @@
==
::
++ handle-action
|= =action
|= =action:store
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ handle-view-action
|= act=view-action
|= act=action:view
^- (list card)
?- -.act
%create (handle-create +.act)
@ -235,7 +235,7 @@
==
::
++ handle-create
|= [=path title=@t description=@t members=create-members real-group=?]
|= [=path title=@t description=@t members=create-members:view real-group=?]
^- (list card)
=/ group-path=^path
?- -.members
@ -273,7 +273,7 @@
::
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:link-listen-hook
!> ^- action:listen-hook
[%watch path]
==
?: ?=(%group -.members) ~
@ -453,6 +453,7 @@
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-submissions'
%- pairs:enjs:format
%+ turn
@ -486,7 +487,7 @@
submissions
|= =submission
^- json
=/ =json (submission:en-json submission)
=/ =json (submission:enjs:store submission)
?> ?=([%o *] json)
:: add in seen status
::
@ -494,7 +495,7 @@
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path path url.submission)]
[%seen (build-discussion-path:store path url.submission)]
:: add in comment count
::
=; comment-count=@ud
@ -507,18 +508,19 @@
=- (~(got by (~(got by -) path)) url.submission)
%+ scry-for (per-path-url comments)
:- %discussions
(build-discussion-path path url.submission)
(build-discussion-path:store path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:en-json u.sub)
(submission:enjs:store u.sub)
=/ =submissions
=- (~(got by -) path)
%+ scry-for (map ^path submissions)
@ -538,35 +540,39 @@
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-discussions'
%^ page-to-json p
%+ get-paginated `p
=- (~(got by (~(got by -) path)) url)
%+ scry-for (per-path-url comments)
[%discussions (build-discussion-path path url)]
comment:en-json
[%discussions (build-discussion-path:store path url)]
comment:enjs:store
::
++ send-update
|= =update
|= =update:store
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path [path url]:update)
(build-discussion-path:store [path url]:update)
::
%observation
%+ give-json
(update:en-json update)
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
~[/json/seen]
==
::

11
pkg/arvo/app/metadata-hook.hoon
View File

@ -47,7 +47,7 @@
::
%metadata-action
[(poke-action:hc !<(metadata-action vase)) this]
==
==
::
++ on-watch
|= =path
@ -162,7 +162,12 @@
++ metadata-scry
|= pax=^path
^- associations
=. pax ;:(weld /=metadata-store/(scot %da now.bowl)/group pax /noun)
=. pax
;: weld
/(scot %p our.bowl)/metadata-store/(scot %da now.bowl)/group
pax
/noun
==
.^(associations %gx pax)
--
::
@ -240,7 +245,7 @@
^- ?
=. pax
;: weld
/=permission-store/(scot %da now.bowl)/permitted
/(scot %p our.bowl)/permission-store/(scot %da now.bowl)/permitted
[(scot %p ship) pax]
/noun
==

22
pkg/arvo/app/metadata-store.hoon
View File

@ -61,9 +61,27 @@
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%metadata-action mark)
?+ mark (on-poke:def mark vase)
%metadata-action
(poke-metadata-action:mc !<(metadata-action vase))
(on-poke:def mark vase)
%noun
=/ val=(each [%cleanup path] tang)
(mule |.(!<([%cleanup path] vase)))
?. ?=(%& -.val)
(on-poke:def mark vase)
=/ group=path +.p.val
=/ res=(set resource) (~(get ju group-indices) group)
=. group-indices (~(del by group-indices) group)
:- ~
%+ roll ~(tap in res)
|= [r=resource out=_state]
=. resource-indices.out (~(del by resource-indices.out) r)
=. app-indices.out
%- ~(del ju app-indices.out)
[app-name.r group app-path.r]
=. associations.out (~(del by associations.out) group r)
out
==
[cards this]
::
++ on-watch

3
pkg/arvo/app/permission-group-hook.hoon
View File

@ -202,7 +202,8 @@
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bowl) pax /noun))
=/ bek=path /(scot %p our.bowl)/group-store/(scot %da now.bowl)
.^((unit group) %gx :(weld bek pax /noun))
::
++ add-members
|= [pax=path mem=(set ship) perms=(set path)]

7
pkg/arvo/app/permission-hook.hoon
View File

@ -296,7 +296,12 @@
++ permission-scry
|= pax=path
^- permission
=. pax ;:(weld /=permission-store/(scot %da now.bowl)/permission pax /noun)
=. pax
;: weld
/(scot %p our.bowl)/permission-store/(scot %da now.bowl)/permission
pax
/noun
==
(need .^((unit permission) %gx pax))
::
++ permitted

4
pkg/arvo/app/ping.hoon
View File

@ -71,7 +71,7 @@
++ stop-ping-ship
|= [our=@p now=@da =ship =old=rift =ship-state]
^- (quip card _state)
=+ .^(=new=rift %j /=rift/(scot %da now)/(scot %p ship))
=+ .^(=new=rift %j /(scot %p our)/rift/(scot %da now)/(scot %p ship))
:: if nothing's changed about us, don't cancel
::
?: ?& =(old-rift new-rift)
@ -96,7 +96,7 @@
(send-ping our now ship)
::
;< new-state=_state (rind card state)
=+ .^(=rift %j /=rift/(scot %da now)/(scot %p ship))
=+ .^(=rift %j /(scot %p our)/rift/(scot %da now)/(scot %p ship))
:_ state(ships (~(put by ships.state) ship rift %idle ~))
[%pass /jael/(scot %p ship) %arvo %j %public-keys (silt ship ~)]~
=. state new-state

129
pkg/arvo/app/publish.hoon
View File

@ -1,13 +1,13 @@
/- *publish,
*group-store,
*group-hook,
*permission-hook,
*permission-group-hook,
*permission-store,
*invite-store,
*metadata-store,
*metadata-hook,
*rw-security
/- *publish
/- *group-store
/- *group-hook
/- *permission-hook
/- *permission-group-hook
/- *permission-store
/- *invite-store
/- *metadata-store
/- *metadata-hook
/- *rw-security
/+ *server, *publish, cram, default-agent, dbug
::
~% %publish ..is ~
@ -127,7 +127,6 @@
::
cards
;: weld
(kill-builds pubs.zero)
kick-cards
init-cards
(move-files old-subs)
@ -225,21 +224,6 @@
[~ subs]
[[%give %kick paths ~]~ subs]
::
++ kill-builds
|= pubs=(map @tas collection-zero)
^- (list card)
%- zing
%+ turn ~(tap by pubs)
|= [col-name=@tas col-data=collection-zero]
^- (list card)
:- [%pass /collection/[col-name] %arvo %f %kill ~]
%- zing
%+ turn ~(tap by pos.col-data)
|= [pos-name=@tas *]
:~ [%pass /post/[col-name]/[pos-name] %arvo %f %kill ~]
[%pass /comments/[col-name]/[pos-name] %arvo %f %kill ~]
==
::
++ send-invites
|= [book=@tas subscribers=(set @p)]
^- (list card)
@ -431,8 +415,13 @@
[%subscribe @ @ ~]
=/ who=@p (slav %p i.t.wir)
=/ book=@tas i.t.t.wir
=/ wen=(unit @da) (get-last-update:main who book)
=/ pax=path
?~ wen
/notebook/[book]
/notebook/[book]/(scot %da u.wen)
:_ this
[%pass wir %agent [who %publish] %watch /notebook/[book]]~
[%pass wir %agent [who %publish] %watch pax]~
::
[%permissions ~]
:_ this
@ -518,6 +507,59 @@
::
|_ bol=bowl:gall
::
++ get-last-update
|= [host=@p book-name=@tas]
^- (unit @da)
=/ book (~(get by books) host book-name)
?~ book ~
=/ wen date-created.u.book
%- some
%- ~(rep by notes.u.book)
|= [[@tas =note] out=_wen]
^- @da
%+ max out
%+ max last-edit.note
%- ~(rep by comments.note)
|= [[@da =comment] out=_out]
(max date-created.comment out)
::
++ get-notebook-from-date
|= [host=@p book-name=@tas wen=@da]
^- notebook
=/ book (~(got by books) host book-name)
%= book
notes
%- ~(rep by notes.book)
|= [[nom=@tas not=note] out=(map @tas note)]
^- (map @tas note)
?: (gth last-edit.not wen)
(~(put by out) nom not)
=. comments.not
%- ~(rep by comments.not)
|= [[nam=@da com=comment] out=(map @da comment)]
?: (gth date-created.com wen)
(~(put by out) nam com)
out
?~ comments.not
out
(~(put by out) nom not)
==
::
++ merge-notebooks
|= [base=notebook diff=notebook]
^- notebook
%= diff
notes
%- ~(rep by notes.diff)
|= [[nom=@tas not=note] out=_notes.base]
=/ base-note=(unit note) (~(get by out) nom)
?~ base-note
(~(put by out) nom not)
=. comments.u.base-note
(~(uni by comments.u.base-note) comments.not)
(~(put by out) nom u.base-note)
==
::
++ read-paths
|= ran=rant:clay
^- (quip card _state)
@ -857,6 +899,19 @@
%.n
==
::
++ get-subscriber-paths
|= [book-name=@tas who=@p]
^- (list path)
%+ roll ~(val by sup.bol)
|= [[whom=@p pax=path] out=(list path)]
?. =(who whom)
out
?. ?=([%notebook @ *] pax)
out
?. =(i.t.pax book-name)
out
[pax out]
::
++ handle-permission-update
|= upd=permission-update
^- (quip card _state)
@ -877,7 +932,7 @@
%+ turn ~(tap in who.upd)
|= who=@p
?. (allowed who %read u.book)
[%give %kick [/notebook/[u.book]]~ `who]~
[%give %kick (get-subscriber-paths u.book who) `who]~
?: ?|(?=(%remove -.upd) (is-managed path.upd))
~
=/ uid (sham %publish who u.book eny.bol)
@ -913,11 +968,15 @@
::
++ watch-notebook
|= pax=path
?> ?=([%notebook @ ~] pax)
?> ?=([%notebook @ *] pax)
=/ book-name i.t.pax
?. (allowed src.bol %read book-name)
~|("not permitted" !!)
=/ book (~(got by books) our.bol book-name)
=/ book
?: ?=([%notebook @ @ ~] pax)
=/ wen=@da (slav %da i.t.t.pax)
(get-notebook-from-date our.bol book-name wen)
(~(got by books) our.bol book-name)
=/ delta=notebook-delta
[%add-book our.bol book-name book]
:_ state
@ -1070,7 +1129,11 @@
^- [(list card) write=path read=path]
?> ?=(^ group-path.group)
=/ scry-path
;:(weld /=group-store/(scot %da now.bol) group-path.group /noun)
;: weld
/(scot %p our.bol)/group-store/(scot %da now.bol)
group-path.group
/noun
==
=/ grp .^((unit ^group) %gx scry-path)
?: use-preexisting.group
?~ grp !!
@ -1766,7 +1829,7 @@
%+ turn ~(tap in dif-peeps)
|= who=@p
^- card
[%give %kick [/notebook/[book.act]]~ `who]
[%give %kick (get-subscriber-paths book.act who) `who]
==
::
++ get-subscribers
@ -1910,6 +1973,8 @@
date-created.data.del
==
==
=? data.del (~(has by books) host.del book.del)
(merge-notebooks (~(got by books) host.del book.del) data.del)
=^ cards state
(emit-updates-and-state host.del book.del data.del del sty)
:_ state

4
pkg/arvo/app/shoe.hoon
View File

@ -40,8 +40,8 @@
::
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like command))
(cold ~ (jest 'demo'))
^+ |~(nail *(like [? command]))
(cold [& ~] (jest 'demo'))
::
++ tab-list
|= sole-id=@ta

114
pkg/arvo/app/spider.hoon
View File

@ -12,15 +12,34 @@
$~ [*thread-form ~]
[=thread-form kid=(map tid trie)]
::
+$ trying ?(%find %build %none)
+$ trying ?(%build %none)
+$ state
$: starting=(map yarn [=trying =vase])
running=trie
tid=(map tid yarn)
==
::
+$ clean-slate-any
$^ clean-slate-ket
$% clean-slate-sig
clean-slate
==
::
+$ clean-slate
$: starting=(map yarn [=trying =vase])
$: %1
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-ket
$: starting=(map yarn [trying=?(%build %find %none) =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ clean-slate-sig
$: starting=~
running=(list yarn)
tid=(map tid yarn)
==
@ -87,9 +106,10 @@
==
::
++ tap-yarn
=| =yarn
|= =trie
^- (list [=^yarn =thread-form])
%- flop :: preorder
=| =yarn
|- ^- (list [=^yarn =thread-form])
%+ welp
?~ yarn
~
@ -116,12 +136,17 @@
++ on-init on-init:def
++ on-save clean-state:sc
++ on-load
|^
|= old-state=vase
=+ !<(=clean-slate old-state)
=. tid.state tid.clean-slate
=+ !<(any=clean-slate-any old-state)
=? any ?=(^ -.any) (old-to-1 any)
=? any ?=(~ -.any) (old-to-1 any)
?> ?=(%1 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
%+ welp running.clean-slate
~(tap in ~(key by starting.clean-slate))
%+ welp running.any
~(tap in ~(key by starting.any))
|- ^- (quip card _this)
?~ yarns
`this
@ -130,10 +155,18 @@
=^ cards-2 this
$(yarns t.yarns)
[(weld cards-1 cards-2) this]
::
++ old-to-1
|= old=clean-slate-ket
^- clean-slate
1+old(starting (~(run by starting.old) |=([* v=vase] none+v)))
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%spider-kill mark)
(on-load on-save)
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-input (on-poke-input:sc !<(input vase))
@ -182,7 +215,6 @@
=^ cards state
?+ wire (on-arvo:def wire sign-arvo)
[%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
==
[cards this]
@ -243,33 +275,15 @@
~| [%already-starting yarn]
!!
::
=: starting.state (~(put by starting.state) yarn [%find vase])
=: starting.state (~(put by starting.state) yarn [%build vase])
tid.state (~(put by tid.state) new-tid yarn)
==
=/ pax=path
~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file))
=/ =card
=/ =schematic:ford [%path [our.bowl %home] %ted file]
[%pass /find/[new-tid] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-find
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(thread-fail-not-running tid %find-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(thread-fail-not-running tid %find-thread-error message.build-result)
?. ?=([%path *] +.build-result)
(thread-fail-not-running tid %find-thread-strange ~)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%build vase]))
=/ =card
=/ =schematic:ford [%core rail.build-result]
[%pass /build/[tid] %arvo %f %build live=%.n schematic]
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
[[card ~] state]
::
++ handle-build
@ -278,16 +292,14 @@
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(thread-fail-not-running tid %build-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(thread-fail-not-running tid %build-thread-error message.build-result)
=/ =cage (result-to-cage:ford build-result)
?. ?=(%noun p.cage)
(thread-fail-not-running tid %build-thread-strange >p.cage< ~)
=/ maybe-thread (mule |.(!<(thread q.cage)))
~| sign+[- +<]:sign-arvo
?> ?=([?(%b %c) %writ *] sign-arvo)
=/ =riot:clay p.sign-arvo
?~ riot
(thread-fail-not-running tid %build-thread-error *tang)
?. ?=(%vase p.r.u.riot)
(thread-fail-not-running tid %build-thread-strange >[p q]:u.riot< ~)
=/ maybe-thread (mule |.(!<(thread !<(vase q.r.u.riot))))
?: ?=(%| -.maybe-thread)
(thread-fail-not-running tid %thread-not-thread ~)
(start-thread yarn p.maybe-thread)
@ -368,15 +380,13 @@
::
++ thread-fail-not-running
|= [=tid =term =tang]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
:_ state(starting (~(del by starting.state) yarn))
%- welp :_ (thread-say-fail tid term tang)
=/ =trying trying:(~(got by starting.state) yarn)
?- trying
%find [%pass /find/[tid] %arvo %f %kill ~]~
%build [%pass /build/[tid] %arvo %f %kill ~]~
%none ~
==
=/ moz (thread-say-fail tid term tang)
?. ?=([~ %build *] (~(get by starting.state) yarn))
moz
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %home ~])
::
++ thread-say-fail
|= [=tid =term =tang]
@ -388,7 +398,7 @@
++ thread-fail
|= [=yarn =term =tang]
^- (quip card ^state)
%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
:: %- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
@ -464,5 +474,5 @@
::
++ clean-state
!> ^- clean-slate
state(running (turn (tap-yarn running.state) head))
1+state(running (turn (tap-yarn running.state) head))
--

257
pkg/arvo/app/test.hoon
View File

@ -1,40 +1,20 @@
/+ default-agent
::
!:
|%
+$ card card:agent:gall
+$ test
$% [%arvo ~] ::UNIMPLEMENTED
[%marks ~] ::UNIMPLEMENTED
[%cores p=path]
[%hoons p=path]
[%names p=path]
[%renders p=path]
+$ test ?(%agents %marks %generators)
+$ state
$: app=(set path)
app-ok=?
mar=(set path)
mar-ok=?
gen=(set path)
gen-ok=?
==
--
::
|%
++ join
|= {a/cord b/(list cord)}
?~ b ''
(rap 3 |-([i.b ?~(t.b ~ [a $(b t.b)])]))
::
++ fake-fcgi [%many [%blob *cred:eyre] $+[%n ~] ~]
++ build-core
|= [=disc:ford a=spur b=(list spur)]
^- card
~& >> (flop a)
:* %pass a-core+a
%arvo %f %build
live=|
^- schematic:ford
:- [%core disc %hoon a]
[%$ %cont !>(b)]
==
--
::
=, ford
=, format
^- agent:gall
=| =state
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
@ -44,121 +24,136 @@
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
:_ this
^- [(list card) _this]
|^
=+ !<(a=test vase)
?- -.a
%arvo ~|(%stub !!) ::basically double solid?
%hoons ~&((list-hoons p.a ~) ~)
%names ~&((list-names p.a) ~)
%marks ~|(%stub !!) ::TODO restore historical handler
%renders ~&(%all-renderers-are-disabled ~)
%cores
=/ spurs [- +]:(list-hoons p.a skip=(sy /sys /ren /tests ~))
[(build-core [p q]:byk.bowl spurs) ~]
=+ !<(=test vase)
?- test
%marks test-marks
%agents test-agents
%generators test-generators
==
::
++ now-beak %_(byk.bowl r [%da now.bowl])
++ list-hoons
|= [under=path skipping=(set spur)] ^- (list spur)
=/ sup (flop under)
~& [%findining-hoons under=under]
|- ^- (list spur)
%- zing
%+ turn
=- (sort ~(tap by -) aor)
dir:.^(arch %cy (en-beam now-beak sup))
|= [a=knot ~] ^- (list spur)
=. sup [a sup]
?: (~(has in skipping) (flop sup))
~&(> [(flop sup) %out-of-scope] ~)
=/ ded (~(get by skip-completely) (flop sup))
?^ ded
~&(> [(flop sup) %skipped `tape`u.ded] ~)
?~ [fil:.^(arch %cy (en-beam now-beak [%hoon sup]))]
^$
~& (flop sup)
[sup ^$]
::
++ list-names
|= a/path ^- (list term)
=/ hon (list-hoons a ~)
%+ turn hon
|= b=spur
(join '-' (slag 1 (flop b)))
::
++ skip-completely
^~ ^- (map path tape)
%- my :~ ::TODO don't hardcode
:- /ren/run "not meant to be called except on a (different) hoon file"
:- /ren/test-gen "temporarily disabled"
++ test-marks
=| fex=(list card)
^+ [fex this]
?> =(~ mar.state)
=. mar-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /mar))
|- ^+ [fex this]
?~ paz [fex this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
=/ mak=^mark
%- crip
%+ turn (tail (spud (tail (flop (tail xap)))))
|=(c=@tD `@tD`?:(=('/' c) '-' c))
=/ sing=card
:+ %pass /build/mar/[mak]
[%arvo %c %warp our.bowl %home ~ %sing %b da+now.bowl /[mak]]
%_ $
paz t.paz
fex [sing fex]
mar.state (~(put in mar.state) /mar/[mak])
==
::
++ test-agents
=| fex=(list card)
^+ [fex this]
?> =(~ app.state)
=. app-ok.state %.y
=+ .^(app-arch=arch cy+(en-beam now-beak /app))
=/ daz ~(tap in ~(key by dir.app-arch))
|- ^+ [fex this]
?~ daz [fex this]
=/ dap-pax=path /app/[i.daz]/hoon
=/ dap-arch .^(arch cy+(en-beam now-beak (flop dap-pax)))
?~ fil.dap-arch
$(daz t.daz)
=/ sing=card
:+ %pass /build/app/[i.daz]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl dap-pax]
%_ $
daz t.daz
fex [sing fex]
app.state (~(put in app.state) /app/[i.daz])
==
::
++ test-generators
=| fex=(list card)
^+ [fex this]
?> =(~ gen.state)
=. gen-ok.state %.y
=+ .^(paz=(list path) ct+(en-beam now-beak /gen))
|- ^+ [fex this]
?~ paz [fex this]
=/ xap=path (flop i.paz)
?. ?=([%hoon *] xap)
$(paz t.paz)
=/ sing=card
:+ %pass build+i.paz
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl i.paz]
%_ $
paz t.paz
fex [sing fex]
gen.state (~(put in gen.state) i.paz)
==
::
++ now-beak %_(byk.bowl r [%da now.bowl])
--
::
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
|^
:_ this
^- (list card)
?. ?=([%a-core *] wire)
^- [(list card) _this]
?. ?=([%build *] wire)
(on-arvo:def wire sign-arvo)
?. ?=(%made +<.sign-arvo)
?. ?=(%writ +<.sign-arvo)
(on-arvo:def wire sign-arvo)
=/ =spur t.wire
=/ res result.sign-arvo
?: ?=([%incomplete *] res)
~& incomplete-core+spur
((slog tang.res) ~)
?. ?=([%complete %success *] res)
~& unsuccessful-core+spur
((slog message.build-result.res) ~)
?> ?=(^ +<.build-result.res)
%- (slog (report-error spur head.build-result.res))
=/ nex=(list ^spur)
=< p
;; [%success %$ %cont * p=(list ^spur)]
tail.build-result.res
?~ nex ~&(%cores-tested ~)
[(build-core [p q]:byk.bowl nex) ~]
=/ =path t.wire
?+ path ~|(path+path !!)
[%app *]
=/ ok
?~ p.sign-arvo |
(~(nest ut -:!>(*agent:gall)) | -:!<(vase q.r.u.p.sign-arvo))
~& ?: ok
agent-built+path
agent-failed+path
=? app-ok.state !ok %.n
=. app.state (~(del in app.state) path)
~? =(~ app.state)
?: app-ok.state
%all-agents-built
%some-agents-failed
[~ this]
::
++ report-error
|= [=spur bud=build-result]
^- tang
=/ should-fail (~(get by failing) (flop spur))
?- -.bud
%success
?~ should-fail ~
:~ leaf+"warn: expected failure, {<`tape`u.should-fail>}"
leaf+"warn: built succesfully"
?: ?=(%bake +<.bud)
(sell q.cage.bud)
?> ?=(%core +<.bud)
(sell vase.bud)
==
::
%error
?^ should-fail
~[>[%failed-known `tape`(weld "TODO: " u.should-fail)]<]
(flop message.bud)
==
[%mar *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
mark-built+path
mark-failed+path
=? mar-ok.state !ok %.n
=. mar.state (~(del in mar.state) path)
~? =(~ mar.state)
?: mar-ok.state
%all-marks-built
%some-marks-failed
[~ this]
::
++ failing
^~ ^- (map path tape)
%- my :~ ::TODO don't hardcode
::
:- /gen/al "compiler types out-of-date"
:- /gen/musk "compiler types out-of-date"
::
:- /gen/cosmetic "incomplete"
:- /gen/lust "incomplete"
:- /gen/scantastic "incomplete"
==
--
::
[%gen *]
=/ ok ?=(^ p.sign-arvo)
~& ?: ok
generator-built+path
generator-failed+path
=? gen-ok.state !ok %.n
=. gen.state (~(del in gen.state) path)
~? =(~ gen.state)
?: gen-ok.state
%all-generators-built
%some-generators-failed
[~ this]
==
++ on-fail on-fail:def
--

6
pkg/arvo/app/weather.hoon
View File

@ -42,8 +42,10 @@
?. ?=([%all ~] wire) (on-watch:def wire)
=/ jon
%- pairs:enjs:format
:~ [%weather data]
[%location s+location]
:* ['location' s+location]
::
?. ?=([%o *] data) ~
~(tap by p.data)
==
:_ this
[%give %fact ~ %json !>(jon)]~

8
pkg/arvo/gen/acme/domain-validation.hoon
View File

@ -20,7 +20,13 @@
[[%404 ~] ~]
=/ challenge=@t i.t.t.q.p.u.url
=/ response
.^((unit @t) %gx /=acme/(scot %da now)/domain-validation/[challenge]/noun)
.^ (unit @t)
%gx
(scot %p p.bek)
%acme
(scot %da now)
/domain-validation/[challenge]/noun
==
?~ response
[[%404 ~] ~]
:- [200 ['content-type' 'text/html']~]

9
pkg/arvo/gen/azimuth-block.hoon
View File

@ -4,6 +4,11 @@
:: processed only those blocks which are this number minus 30.
::
:- %say
|= [[now=@da *] *]
|= [[now=@da @ our=@p ^] *]
:- %tang
[>.^(@ud %gx /=eth-watcher/(scot %da now)/block/azimuth-tracker/noun)< ~]
=; block=@ud
[leaf+(scow %ud block)]~
.^ @ud
%gx
/(scot %p our)/eth-watcher/(scot %da now)/block/azimuth-tracker/noun
==

4
pkg/arvo/gen/azimuth-sources.hoon
View File

@ -1,5 +1,5 @@
:: List azimuth sources
:- %say
|= [[now=@da *] *]
|= [[now=@da @ our=@p ^] *]
:- %noun
.^(state-eth-node:jael j//=sources/(scot %da now))
.^(state-eth-node:jael j//(scot %p our)/sources/(scot %da now))

3
pkg/arvo/gen/glob/make.hoon Normal file
View File

@ -0,0 +1,3 @@
:- %say
|= *
[%glob-make ~]

1
pkg/arvo/gen/hello.hoon
View File

@ -2,6 +2,7 @@
::
:::: /hoon/hello/gen
::
:: TODO: reinstate
/? 310
::
::::

14
pkg/arvo/gen/hood/autoload.hoon
View File

@ -1,14 +0,0 @@
:: Helm: Disable/enable/toggle auto-reload of kernel components
::
:::: /hoon/autoload/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{arg/?(~ {? ~}) ~}
==
:- %kiln-autoload
`(unit ?)`?~(arg ~ `-.arg)

13
pkg/arvo/gen/hood/keep-ford.hoon
View File

@ -1,13 +0,0 @@
:: Kiln: resize Ford cache
::
::::
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[compiler-cache-size=@ud build-cache-size=@ud ~] ~]
==
[%kiln-keep-ford compiler-cache-size build-cache-size]

15
pkg/arvo/gen/hood/load.hoon
View File

@ -1,15 +0,0 @@
:: Hood, generic: load named hood component's state from backup
::
:::: /hoon/load/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ byk/beak}
{{dap/term pas/@uw ~} ~}
==
:- %hood-load
~| %hood-load-stub
!!

14
pkg/arvo/gen/hood/ota.hoon Normal file
View File

@ -0,0 +1,14 @@
:: Kiln: Continuously merge local desk from (optionally-)foreign one
::
:::: /hoon/ota/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [her=@p sud=@tas ~]) ~]
==
:- %kiln-ota
?~(arg ~ `[her sud]:arg)

13
pkg/arvo/gen/hood/overload.hoon
View File

@ -1,13 +0,0 @@
:: Kiln: regularly clear %ford cache XX find relevant leak
::
:::: /hoon/overload/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{{recur/@dr start/@da ~} ~}
==
[%kiln-overload recur start]

2
pkg/arvo/gen/hood/reboot.hoon
View File

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

13
pkg/arvo/gen/hood/rf.hoon
View File

@ -1,13 +0,0 @@
:: Helm: Reload %ford
::
:::: /hoon/rf/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: {now/@da eny/@uvJ bec/beak}
{arg/~ ~}
==
[%helm-reload ~[%f]]

79
pkg/arvo/gen/hood/static.hoon
View File

@ -1,79 +0,0 @@
:: Serve static files
/? 309
::
/= pre-process
/^ (map path [@tas @t])
/: /===/web/static-site /*
/| /; |=(@t [%html +<]) /&html&/!hymn/
/; |=(@t [%html +<]) /&html&/&elem&/udon/
:: XX /lib/down-jet/parse is broken
:: /; |=(@t [%html +<]) /&html&/&hymn&/&down&/md/
/; |=(@t [%raw +<]) /atom/
==
::
~& %finished-preprocessing
:- %say
|= $: [now=@da eny=@uv bec=beak]
~
~
==
=>
|%
++ convert-link
|= [pre=tape link=tape]
=/ parsed=(unit (list coin))
%+ rust link
;~ pose
;~(pfix net (more net nuck:so))
(more net nuck:so)
==
?~ parsed
link
^- tape
%+ welp
=< +
%^ spin u.parsed pre
|= [c=coin s=path]
^- [* out=tape]
?> ?=([%$ dime] c)
[0 (weld "{s}/" (scow +.c))]
::
".html"
::
++ convert-file
|= [pre=tape fil=tape]
^- tape
=/ idc=(list @ud) (fand "<a href=" fil)
=< +>
%^ spin idc [0 fil]
|= [i=@ud f=@ud h=tape]
^- [p=* f=@ud out=tape]
=/ a (scag :(add 9 i f) h)
=/ b (slag :(add 9 i f) h)
=/ c (need (find "\">" b))
=/ old-link=tape (scag c b)
=/ new-link=tape (convert-link pre old-link)
=/ new-file=tape :(welp a new-link (slag c b))
=/ new-f (sub (lent new-link) (lent old-link))
[0 (add f new-f) new-file]
--
::
:- %dill-blit
=/ trio /(scot %p p.bec)/[q.bec]/(scot r.bec)
=/ dirs .^((list path) %ct (weld trio /web/static-site))
::
:- %mor
%+ roll dirs
|= [pax=path out=(list [%sav path @t])]
=/ path-prefix=path (scag (dec (lent pax)) pax)
=/ pre=[@tas @t] (~(got by pre-process) path-prefix)
:_ out
:- %sav
?: =(%raw -.pre)
[pax +.pre]
:: find and update links
=/ root=tape
?~ path-prefix ""
(slag 1 (spud (scag 1 (flop path-prefix))))
=/ fil=tape (convert-file root (trip +.pre))
[(weld path-prefix /[-.pre]) (crip fil)]

14
pkg/arvo/gen/hood/wipe-ford.hoon
View File

@ -1,14 +0,0 @@
:: Kiln: wipe ford cache
::
:::: /hoon/wipe-ford/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[percent=@ud ~]
~
==
[%kiln-wipe-ford percent]

9
pkg/arvo/gen/keys.hoon
View File

@ -1,8 +1,11 @@
:: Print keys for a ship
::
:- %say
|= [[now=time *] [=ship ~] ~]
|= [[now=time @ our=ship ^] [her=ship ~] ~]
=/ our (scot %p our)
=/ now (scot %da now)
=/ her (scot %p her)
:* %noun
life=.^((unit @ud) %j /=lyfe/(scot %da now)/(scot %p ship))
rift=.^((unit @ud) %j /=ryft/(scot %da now)/(scot %p ship))
life=.^((unit @ud) %j /[our]/lyfe/[now]/[her])
rift=.^((unit @ud) %j /[our]/ryft/[now]/[her])
==

2
pkg/arvo/gen/link-store/note.hoon
View File

@ -1,6 +1,6 @@
:: link-store|note: write a note on a link in a path
::
/- *link
/- *link-store, *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path =url note=@t ~] ~]

2
pkg/arvo/gen/link-store/save.hoon
View File

@ -1,6 +1,6 @@
:: link-store|save: save a link to a path
::
/- *link
/- *link-store, *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path title=@t =url ~] ~]

4
pkg/arvo/gen/metal.hoon
View File

@ -207,10 +207,6 @@
::
(vent %e /vane/eyre)
::
:: sys/vane/ford: build
::
(vent %f /vane/ford)
::
:: sys/vane/gall: applications
::
(vent %g /vane/gall)

7
pkg/arvo/gen/spider/tree.hoon
View File

@ -1,10 +1,13 @@
:: List running threads
/- spider
:- %say
|= [[now=@da *] ~ *]
|= [[now=@da @ our=@p ^] ~ *]
:- %tang
=/ tree
.^((list (list tid:spider)) %gx /=spider/(scot %da now)/tree/noun)
.^ (list (list tid:spider))
%gx
/(scot %p our)/spider/(scot %da now)/tree/noun
==
%+ turn tree
|= yarn=(list tid:spider)
>`path`yarn<

83
pkg/arvo/gen/test.hoon
View File

@ -1,83 +0,0 @@
:: Run tests
/+ test-runner
/= all-tests
/^ (map path (list test-arm:test-runner))
/: /===/tests
/* /test-gen/
::
|%
++ main
|= [defer=? tests=(list test:test-runner)]
^- tang
::
%- zing
%+ turn tests
|= [=path test-func=test-func:test-runner]
^- tang
::
=/ test-results=tang (run-test path test-func)
:: if :defer is set, produce errors; otherwise print them and produce ~
::
?: defer
test-results
((slog (flop test-results)) ~)
::
++ run-test
:: executes an individual test.
|= [pax=path test=test-func:test-runner]
^- tang
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| :: the stack is already flopped for output?
;: weld
p.run
`tang`[[%leaf (weld "CRASHED " name)] ~]
==
%& ?: =(~ p.run)
[[%leaf (weld "OK " name)] ~]
:: Create a welded list of all failures indented.
%- flop
;: weld
`tang`[[%leaf (weld "FAILED " name)] ~]
::TODO indent
:: %+ turn p:run
:: |= {i/tape}
:: ^- tank
:: [%leaf (weld " " i)]
p.run
==
==
:: +filter-tests-by-prefix
::
++ filter-tests-by-prefix
|= [prefix=path tests=(list test:test-runner)]
^+ tests
::
=/ prefix-length=@ud (lent prefix)
::
%+ skim tests
::
|= [=path *]
=(prefix (scag prefix-length path))
--
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[filter=$?(~ [pax=path ~])]
[defer=_& seed=?(~ @uvJ)]
==
:: start printing early if we're not deferring output
::
~? !defer %tests-compiled
:- %tang
:: use empty path prefix if unspecified
::
=/ prefix=path ?~(filter ~ pax.filter)
::
=/ filtered-tests=(list test:test-runner)
%+ filter-tests-by-prefix
prefix
(resolve-test-paths:test-runner all-tests)
::
(main defer filtered-tests)

10
pkg/arvo/gen/timers.hoon
View File

@ -1,5 +1,9 @@
:: Find list of currently running Behn timers
:- %say
|= [[now=@da *] *]
:- %tang
[>.^((list [date=@da =duct]) %bx /=//(scot %da now)/debug/timers)< ~]
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
=; timers
[%tang >timers< ~]
.^ (list [date=@da =duct])
%bx
(en-beam:format [p.bec %$ r.bec] /debug/timers)
==

13
pkg/arvo/gen/trouble.hoon
View File

@ -7,8 +7,9 @@
:- %noun
=<
:~
[%base-hash .^(@uv %cz (pathify ~.base ~))]
[%base-hash base-hash]
[%home-hash .^(@uv %cz (pathify ~.home ~))]
[%kids-hash .^(@uv %cz (pathify ~.kids ~))]
::
(info %our our)
(info %sponsor sponsor)
@ -40,4 +41,14 @@
life=lyfe
rift=ryft
==
::
++ base-hash
=+ .^ ota=(unit [=ship =desk =aeon:clay])
%gx /(scot %p our)/hood/(scot %da now)/kiln/ota/noun
==
?~ ota
*@uv
=/ parent (scot %p ship.u.ota)
=+ .^(=cass:clay %cs /[parent]/[desk.u.ota]/1/late/foo)
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
--

146
pkg/arvo/lib/hood/drum.hoon
View File

@ -1,33 +1,16 @@
:: :: ::
:::: /hoon/drum/hood/lib :: ::
:: :: ::
/? 310 :: version
/- *sole
/+ sole
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$drum $2 pith-2} ::
++ part-old {$drum $1 pith-1} ::
:: ::
++ pith-1 :: pre-style
%+ cork pith-2 ::
|:($:pith-2 +<(bin ((map bone source-1)))) ::
:: ::
++ source-1 ::
%+ cork source ::
|:($:source +<(mir ((pair @ud (list @c))))) :: style-less mir
:: ::
/- *sole
/+ sole
|%
+$ any-state $%(state)
+$ state [%2 pith-2]
::
++ pith-2 ::
$: eel/(set gill:gall) :: connect to
ray/(set well:gall) ::
fur/(map dude:gall (unit server)) :: servers
bin/(map bone source) :: terminals
== ::
:: :: ::
:::: :: ::
:: :: ::
:: ::
++ server :: running server
$: syd/desk :: app identity
cas/case :: boot case
@ -72,7 +55,7 @@
:: :: ::
|%
++ deft-apes :: default servers
|= [our/ship lit/?]
|= [our=ship lit=?]
%- ~(gas in *(set well:gall))
^- (list well:gall)
:: boot all default apps off the home desk
@ -119,44 +102,38 @@
%metadata-hook
%s3-store
%file-server
%glob
==
::
++ deft-fish :: default connects
|= our/ship
|= our=ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
[[our %dojo] [our %chat-cli]~]
::
++ make :: initial part
|= our/ship
^- part
:* %drum
%2
eel=(deft-fish our)
ray=~
fur=~
bin=~
==
::
::
++ en-gill :: gill to wire
|= gyl/gill:gall
|= gyl=gill:gall
^- wire
[%drum %phat (scot %p p.gyl) q.gyl ~]
::
++ de-gill :: gill from wire
|= way/wire ^- gill:gall
?>(?=({@ @ ~} way) [(slav %p i.way) i.t.way])
|= way=wire ^- gill:gall
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
--
:: TODO: remove .ost
::
::::
::
|= {hid/bowl:gall part} :: main drum work
|= [hid=bowl:gall state]
=* sat +<+
=/ ost 0
=+ (~(gut by bin) ost *source)
=* dev -
|_ {moz/(list card:agent:gall) biz/(list dill-blit:dill)}
+* this .
=| moz=(list card:agent:gall)
=| biz=(list dill-blit:dill)
|%
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ on-init se-abet:this(eel (deft-fish our.hid))
++ diff-sole-effect-phat :: app event
|= {way/wire fec/sole-effect}
=< se-abet =< se-view
@ -172,14 +149,15 @@
(se-text "[{<src.hid>}, driving {<our.hid>}]")
::
++ poke-set-boot-apps ::
|= lit/?
^- (quip card:agent:gall part)
|= lit=?
^- (quip card:agent:gall ^state)
:: We do not run se-abet:se-view here because that starts the apps,
:: and some apps are not ready to start (eg Talk crashes because the
:: terminal has width 0). It appears the first message to drum must
:: be the peer.
::
[~ +<+.^$(ray (deft-apes our.hid lit))]
=. ray (deft-apes our.hid lit)
[~ sat]
::
++ poke-dill-belt :: terminal event
|= bet/dill-belt:dill
@ -193,7 +171,7 @@
++ poke-start :: start app
|= wel/well:gall
=< se-abet =< se-view
(se-born wel)
(se-born & wel)
::
++ poke-link :: connect app
|= gyl/gill:gall
@ -216,38 +194,42 @@
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-drum-bad-mark mark] !!)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
%drum-dill-belt =;(f (f !<(_+<.f vase)) poke-dill-belt)
%drum-dill-blit =;(f (f !<(_+<.f vase)) poke-dill-blit)
%drum-exit =;(f (f !<(_+<.f vase)) poke-exit)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-set-boot-apps =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
==
::
++ on-load
|= ver=?(%1 %2 %3 %4 %5)
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7 %8) old=any-state]
=< se-abet =< se-view
=? . (lte ver %4)
=. ver %5
=. ..on-load
=< (se-emit %pass /kiln %arvo %g %sear ~wisrut-nocsub)
=< (se-born %home %goad)
=< (se-born %home %metadata-store)
=< (se-born %home %metadata-hook)
=< (se-born %home %contact-store)
=< (se-born %home %contact-hook)
=< (se-born %home %contact-view)
=< (se-born %home %link-store)
=< (se-born %home %link-proxy-hook)
=< (se-born %home %link-listen-hook)
=< (se-born %home %link-view)
=< (se-born %home %s3-store)
(se-born %home %file-server)
.
?> ?=(%5 ver)
=> (se-born %home %file-server)
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=. sat old
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (se-born | %home %link-view)
=> (se-born | %home %link-listen-hook)
=> (se-born | %home %link-store)
=> (se-born | %home %link-proxy-hook)
=> (se-born | %home %contact-view)
=> (se-born | %home %contact-hook)
=> (se-born | %home %contact-store)
=> (se-born | %home %metadata-hook)
=> (se-born | %home %metadata-store)
=> (se-born | %home %goad)
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=? ..on-load (lte hood-version %5)
(se-born | %home %file-server)
=? ..on-load (lte hood-version %7)
(se-born | %home %glob)
..on-load
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
@ -260,7 +242,7 @@
::
(se-drop & gyl)
::
++ take ::
++ take-arvo
|= [=wire =sign-arvo]
%+ take-onto wire
?> ?=(%onto +<.sign-arvo)
@ -314,10 +296,9 @@
:::: :: ::
:: :: ::
++ se-abet :: resolve
^- (quip card:agent:gall part)
=* pith +<+.$
^- (quip card:agent:gall state)
=. . se-subze:se-adze:se-adit
:_ pith(bin (~(put by bin) ost dev))
:_ sat(bin (~(put by bin) ost dev))
^- (list card:agent:gall)
?~ biz (flop moz)
:_ (flop moz)
@ -345,7 +326,7 @@
(se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
=. this
%- se-emit
[%pass wire %arvo %g %conf [our.hid q.wel] our.hid p.wel]
[%pass wire %arvo %g %conf q.wel]
$(servers t.servers)
::
++ priorities
@ -466,9 +447,10 @@
ta-abet:(ta-belt:(se-tame u.gul) bet)
::
++ se-born :: new server
|= wel/well:gall
|= [print-on-repeat=? wel=well:gall]
^+ +>
?: (~(has in ray) wel)
?. print-on-repeat +>
(se-text "[already running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(put in ray) wel)

161
pkg/arvo/lib/hood/helm.hoon
View File

@ -1,55 +1,45 @@
:: :: ::
:::: /hoon/helm/hood/lib :: ::
:: :: ::
/? 310 :: version
/- sole
/+ pill
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
++ part {$helm $0 pith} :: helm state
++ pith :: helm content
$: hoc/(map bone session) :: consoles
== ::
++ session ::
$: say/sole-share:sole :: console state
mud/(unit (sole-dialog:sole @ud)) :: console dialog
mass-timer/{way/wire nex/@da tim/@dr}
== ::
:: :: ::
:::: :: ::
:: :: ::
++ hood-reset :: reset command
$~ ::
++ helm-verb :: reset command
$~ ::
++ hood-reload :: reload command
(list term) ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|: $:{bowl:gall part} :: main helm work
=/ ost 0
=+ sez=(~(gut by hoc) ost $:session)
=| moz=(list card:agent:gall)
/+ pill
=* card card:agent:gall
|%
++ abet
[(flop moz) %_(+<+.$ hoc (~(put by hoc) ost sez))]
+$ any-state $%(state state-0)
+$ state
$: %1
mass-timer=[way=wire nex=@da tim=@dr]
==
+$ state-0 [%0 hoc=(map bone session-0)]
+$ session-0
$: say=*
mud=*
mass-timer=[way=wire nex=@da tim=@dr]
==
::
++ emit
|= card:agent:gall
%_(+> moz [+< moz])
++ state-0-to-1
|= s=state-0
^- state
[%1 mass-timer:(~(got by hoc.s) 0)]
--
|= [=bowl:gall sat=state]
=| moz=(list card)
|%
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ abet [(flop moz) sat]
++ flog |=(=flog:dill (emit %pass /di %arvo %d %flog flog))
++ emit |=(card this(moz [+< moz]))
:: +emil: emit multiple cards
::
++ flog
|= =flog:dill
(emit %pass /di %arvo %d %flog flog)
++ emil
|= caz=(list card)
^+ this
?~(caz this $(caz t.caz, this (emit i.caz)))
::
++ emil :: return cards
|= (list card:agent:gall)
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
++ on-load
|= [hood-version=@ud old=any-state]
=< abet
=? old ?=(%0 -.old) (state-0-to-1 old)
?> ?=(%1 -.old)
this(sat old)
::
++ poke-rekey :: rotate private keys
|= des=@t
@ -60,17 +50,33 @@
=< abet
?~ sed
~& %invalid-private-key
+>.$
?. =(our who.u.sed)
this
?. =(our.bowl who.u.sed)
~& [%wrong-private-key-ship who.u.sed]
+>.$
this
(emit %pass / %arvo %j %rekey lyf.u.sed key.u.sed)
::
++ ames-secret
^- @t
=; pax (crip +:<.^(@p %j pax)>)
/(scot %p our.bowl)/code/(scot %da now.bowl)/(scot %p our.bowl)
::
++ poke-sec-atom
|= [hot=host:eyre dat=@]
?> ?=(%& -.hot)
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
=- abet:(emit %pass /write %arvo %c %info -)
=/ byk=path (en-beam:format byk.bowl(r da+now.bowl) ~)
=+ .^(=tube:clay cc+(welp byk /mime/atom))
=/ =cage atom+(tube !>([/ (as-octs:mimes:html dat)]))
(foal:space:userlib :(welp byk sec+p.hot /atom) cage)
::
++ poke-moon :: rotate moon keys
|= sed=(unit [=ship =udiff:point:able:jael])
=< abet
?~ sed
+>.$
this
(emit %pass / %arvo %j %moon u.sed)
::
++ poke-mass
@ -79,13 +85,13 @@
::
++ poke-automass
|= recur=@dr
=. mass-timer.sez
[/helm/automass (add now recur) recur]
abet:(emit %pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez)
=. mass-timer.sat
[/helm/automass (add now.bowl recur) recur]
abet:(emit %pass way.mass-timer.sat %arvo %b %wait nex.mass-timer.sat)
::
++ poke-cancel-automass
|= ~
abet:(emit %pass way.mass-timer.sez %arvo %b %rest nex.mass-timer.sez)
abet:(emit %pass way.mass-timer.sat %arvo %b %rest nex.mass-timer.sat)
::
++ poke-pack
|= ~ =< abet
@ -97,11 +103,11 @@
%- (slog u.error)
~& %helm-wake-automass-fail
abet
=. nex.mass-timer.sez (add now tim.mass-timer.sez)
=. nex.mass-timer.sat (add now.bowl tim.mass-timer.sat)
=< abet
%- emil
:~ [%pass /heft %arvo %d %flog %crud %hax-heft ~]
[%pass way.mass-timer.sez %arvo %b %wait nex.mass-timer.sez]
[%pass way.mass-timer.sat %arvo %b %wait nex.mass-timer.sat]
==
::
++ poke-send-hi
@ -119,14 +125,14 @@
?: =(%fail mes)
~& %poke-hi-fail
!!
abet:(flog %text "< {<src>}: {(trip mes)}")
abet:(flog %text "< {<src.bowl>}: {(trip mes)}")
::
++ poke-atom
|= ato/@
=+ len=(scow %ud (met 3 ato))
=+ gum=(scow %p (mug ato))
=< abet
(flog %text "< {<src>}: atom: {len} bytes, mug {gum}")
(flog %text "< {<src.bowl>}: atom: {len} bytes, mug {gum}")
::
++ coup-hi
|= {pax/path cop/(unit tang)} =< abet
@ -138,7 +144,7 @@
|: $:{syd/desk all/(list term)} =< abet
%- emil
%+ turn all
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)
=+ top=`path`/(scot %p our.bowl)/[syd]/(scot %da now.bowl)
=/ van/(list {term ~})
:- zus=[%zuse ~]
~(tap by dir:.^(arch %cy (welp top /sys/vane)))
@ -161,14 +167,15 @@
:: Trigger with |reset.
::
++ poke-reset
|= hood-reset
|= hood-reset=~
=< abet
%- emil
^- (list card:agent:gall)
=/ top=path /(scot %p our)/home/(scot %da now)/sys
=/ hun .^(@ %cx (welp top /hoon/hoon))
=/ arv .^(@ %cx (welp top /arvo/hoon))
:- [%pass /reset %arvo %d %flog %lyra `@t`hun `@t`arv]
=/ top=path /(scot %p our.bowl)/home/(scot %da now.bowl)/sys
=/ hun .^(@t %cx (welp top /hoon/hoon))
=/ arv .^(@t %cx (welp top /arvo/hoon))
~! *task:able:dill
:- [%pass /reset %arvo %d %flog %lyra `hun arv]
%+ turn
(module-ova:pill top)
|=([=wire =flog:dill] [%pass wire %arvo %d %flog flog])
@ -200,23 +207,25 @@
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-helm-bad-mark mark] !!)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-ames-wake =;(f (f !<(_+<.f vase)) poke-ames-wake)
%helm-atom =;(f (f !<(_+<.f vase)) poke-atom)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-pack =;(f (f !<(_+<.f vase)) poke-pack)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-reload =;(f (f !<(_+<.f vase)) poke-reload)
%helm-reload-desk =;(f (f !<(_+<.f vase)) poke-reload-desk)
%helm-reset =;(f (f !<(_+<.f vase)) poke-reset)
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-ames-wake =;(f (f !<(_+<.f vase)) poke-ames-wake)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
%helm-automass =;(f (f !<(_+<.f vase)) poke-automass)
%helm-cancel-automass =;(f (f !<(_+<.f vase)) poke-cancel-automass)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-serve =;(f (f !<(_+<.f vase)) poke-serve)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
==
::
++ take-agent
@ -230,7 +239,7 @@
|= [wir=wire success=? binding=binding:eyre] =< abet
(flog %text "bound: {<success>}")
::
++ take
++ take-arvo
|= [=wire =sign-arvo]
?+ wire ~|([%helm-bad-take-wire wire +<.sign-arvo] !!)
[%automass *] %+ take-wake-automass t.wire

672
pkg/arvo/lib/hood/kiln.hoon
View File

@ -1,67 +1,66 @@
:: :: ::
:::: /hoon/kiln/hood/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
=, clay
=, space:userlib
=, format
|% :: ::
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: rem/(map desk per-desk) ::
syn/(map kiln-sync let/@ud) ::
autoload-on/? ::
cur-hoon/@uvI ::
cur-arvo/@uvI ::
cur-zuse/@uvI ::
cur-vanes/(map @tas @uvI) ::
commit-timer/{way/wire nex/@da tim/@dr mon=term}
== ::
++ per-desk :: per-desk state
$: auto/? :: escalate on failure
gem/germ :: strategy
her/@p :: from ship
sud/@tas :: from desk
cas/case :: at case
== ::
:: :: ::
:::: :: ::
:: :: ::
++ kiln-commit term ::
++ kiln-mount ::
$: pax/path ::
pot/term ::
== ::
++ kiln-unmount $@(term {knot path}) ::
++ kiln-sync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-unsync ::
$: syd/desk ::
her/ship ::
sud/desk ::
== ::
++ kiln-merge ::
$: syd/desk ::
ali/ship ::
sud/desk ::
cas/case ::
gim/?($auto germ) ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|= {bowl:gall part} :: main kiln work
|%
+$ state [%1 pith-1]
+$ any-state
$% state
[%0 pith-0]
==
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
== ::
+$ pith-0 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
autoload-on=? ::
cur-hoon=@uvI ::
cur-arvo=@uvI ::
cur-zuse=@uvI ::
cur-vanes=(map @tas @uvI) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
==
+$ per-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
her=@p :: from ship
sud=@tas :: from desk
cas=case :: at case
==
+$ kiln-commit term ::
+$ kiln-mount ::
$: pax=path ::
pot=term ::
==
+$ kiln-unmount $@(term [knot path]) ::
+$ kiln-sync ::
$: syd=desk ::
her=ship ::
sud=desk ::
==
+$ kiln-unsync ::
$: syd=desk ::
her=ship ::
sud=desk ::
==
+$ kiln-merge ::
$: syd=desk ::
ali=ship ::
sud=desk ::
cas=case ::
gim=?($auto germ) ::
==
--
|= [bowl:gall state]
?> =(src our)
|_ moz/(list card:agent:gall)
|_ moz=(list card:agent:gall)
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ abet :: resolve
[(flop moz) `part`+<+.$]
[(flop moz) `state`+<+.$]
::
++ emit
|= card:agent:gall
@ -74,9 +73,44 @@
::
++ render
|= {mez/tape sud/desk who/ship syd/desk}
:^ %palm [" " ~ ~ ~] leaf+mez
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
::
++ on-load
|= [hood-version=@ud old=any-state]
=< abet
=? . ?=(%0 -.old)
=/ recognized-ota=(unit [syd=desk her=ship sud=desk])
=/ syncs=(list [[syd=desk her=ship sud=desk] =aeon])
~(tap by syn.old)
|- ^- (unit [syd=desk her=ship sud=desk])
?~ syncs
~
?: &(=(%base syd.i.syncs) !=(our her.i.syncs) =(%kids sud.i.syncs))
`[syd her sud]:i.syncs
$(syncs t.syncs)
::
=. +<+.$.abet
=- old(- %1, |3 [ota=~ commit-timer.old], syn -)
?~ recognized-ota
syn
(~(del by syn) [syd her sud]:u.recognized-ota)
::
=? ..abet ?=(^ recognized-ota)
(poke-internal:update `[her sud]:u.recognized-ota)
+(old +<+.$.abet)
::
?> ?=(%1 -.old)
=. +<+.$.abet old
..abet
::
++ on-peek
|= =path
^- (unit (unit cage))
?. ?=([%x %kiln %ota ~] path)
[~ ~]
``noun+!>(ota)
::
++ poke-commit
|= [mon/kiln-commit auto=?]
=< abet
@ -127,6 +161,180 @@
abet:(spam (render "already tracking" [sud her syd]:hos) ~)
abet:abet:start-track:(auto hos)
::
++ update
|%
++ make-wire
|= =path
?> ?=(^ ota)
%- welp
:_ path
/kiln/ota/(scot %p ship.u.ota)/[desk.u.ota]/(scot %ud aeon.u.ota)
::
++ check-ota
|= =wire
?~ ota
|
?& ?=([@ @ @ *] wire)
=(i.wire (scot %p ship.u.ota))
=(i.t.wire desk.u.ota)
=(i.t.t.wire (scot %ud aeon.u.ota))
==
::
++ render
|= [mez=tape error=(unit (pair term tang))]
%+ spam
?~ ota
leaf+mez
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<desk.u.ota>}" leaf+"on {<ship.u.ota>}"]
?~ error
~
[>p.u.error< q.u.error]
::
++ render-ket
|= [mez=tape error=(unit (pair term tang))]
?> ?=(^ ota)
=< ?>(?=(^ ota) .)
%+ spam
:^ %palm [" " ~ ~ ~] leaf+(weld "kiln: " mez)
~[leaf+"from {<desk.u.ota>}" leaf+"on {<ship.u.ota>}"]
?~ error
~
[>p.u.error< q.u.error]
::
:: If destination desk doesn't exist, need a %init merge. If this is
:: its first revision, it probably doesn't have a mergebase yet, so
:: use %that.
::
++ get-germ
|= =desk
=+ .^(=cass:clay %cw /(scot %p our)/home/(scot %da now))
?- ud.cass
%0 %init
%1 %that
* %mate
==
::
++ poke
|= arg=(unit [=ship =desk])
abet:(poke-internal arg)
::
++ poke-internal
|= arg=(unit [=ship =desk])
^+ ..abet
=? ..abet =(arg (bind ota |=([=ship =desk =aeon] [ship desk])))
(render "restarting OTA sync" ~)
=? ..abet ?=(^ ota)
=. ..abet (render-ket "cancelling OTA sync" ~)
..abet(ota ~)
?~ arg
..abet
=. ota `[ship.u.arg desk.u.arg *aeon]
=. ..abet (render "starting OTA sync" ~)
%: emit
%pass (make-wire /find) %arvo %c
%warp ship.u.arg desk.u.arg `[%sing %y ud+1 /]
==
::
++ take
|= [=wire =sign-arvo]
^+ ..abet
?> ?=(^ ota)
?. (check-ota wire)
..abet
?. ?=([@ @ @ @ *] wire)
..abet
?+ i.t.t.t.wire ~&([%strange-ota-take t.t.t.wire] ..abet)
%find (take-find sign-arvo)
%sync (take-sync sign-arvo)
%download (take-download sign-arvo)
%merge-home (take-merge-home sign-arvo)
%merge-kids (take-merge-kids sign-arvo)
==
::
++ take-find
|= =sign-arvo
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
=. ..abet (render-ket "activated OTA" ~)
%: emit
%pass (make-wire /sync) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %w da+now /]
==
::
++ take-sync
|= =sign-arvo
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
?~ p.sign-arvo
=. ..abet (render-ket "OTA cancelled (1), retrying" ~)
(poke-internal `[ship desk]:u.ota)
=. ..abet (render-ket "downloading OTA update" ~)
=? aeon.u.ota ?=($w p.p.u.p.sign-arvo)
ud:;;(cass:clay q.q.r.u.p.sign-arvo)
%: emit
%pass (make-wire /download) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %v ud+aeon.u.ota /]
==
::
++ take-download
|= =sign-arvo
^+ ..abet
?> ?=(%writ +<.sign-arvo)
?> ?=(^ ota)
?~ p.sign-arvo
=. ..abet (render-ket "OTA cancelled (2), retrying" ~)
(poke-internal `[ship desk]:u.ota)
=. ..abet (render-ket "finished downloading OTA" ~)
=. aeon.u.ota +(aeon.u.ota)
=/ =germ (get-germ %home)
=. ..abet (render-ket "applying OTA to %home" ~)
%- emil
:~ :* %pass (make-wire /merge-home) %arvo %c
%merg %home ship.u.ota desk.u.ota ud+(dec aeon.u.ota) germ
==
:* %pass (make-wire /sync) %arvo %c
%warp ship.u.ota desk.u.ota `[%sing %z ud+aeon.u.ota /]
==
==
::
++ take-merge-home
|= =sign-arvo
?> ?=(%mere +<.sign-arvo)
?> ?=(^ ota)
?: ?=([%| %ali-unavailable *] p.sign-arvo)
=. ..abet
=/ =tape "OTA to %home failed, maybe because sunk; restarting"
(render-ket tape `p.p.sign-arvo)
(poke-internal `[ship desk]:u.ota)
::
?: ?=(%| -.p.sign-arvo)
=/ =tape "OTA to %home failed, waiting for next revision"
(render-ket tape `p.p.sign-arvo)
=. ..abet (render-ket "OTA to %home succeeded" ~)
=. ..abet (render-ket "applying OTA to %kids" ~)
=/ =germ (get-germ %kids)
%: emit
%pass (make-wire /merge-kids) %arvo %c
%merg %kids ship.u.ota desk.u.ota ud+(dec aeon.u.ota) germ
==
::
++ take-merge-kids
|= =sign-arvo
?> ?=(%mere +<.sign-arvo)
?> ?=(^ ota)
?: ?=([%| %ali-unavailable *] p.sign-arvo)
=. ..abet
=/ =tape "OTA to %kids failed, maybe because sunk; restarting"
(render-ket tape `p.p.sign-arvo)
(poke-internal `[ship desk]:u.ota)
::
?- -.p.sign-arvo
%& (render-ket "OTA to %kids succeeded" ~)
%| (render-ket "OTA to %kids failed" `p.p.sign-arvo)
==
--
::
++ poke-sync ::
|= hos/kiln-sync
?: (~(has by syn) hos)
@ -136,8 +344,12 @@
++ poke-syncs :: print sync config
|= ~
=< abet %- spam
:- :- %leaf
?~ ota
"OTAs disabled"
"OTAs from {<desk.u.ota>} on {<ship.u.ota>}"
?: =(0 ~(wyt by syn))
[%leaf "no syncs configured"]~
[%leaf "no other syncs configured"]~
%+ turn ~(tap in ~(key by syn))
|=(a/kiln-sync (render "sync configured" [sud her syd]:a))
::
@ -190,127 +402,30 @@
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
++ poke-start-autoload |=(~ abet:start:autoload)
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-goad-gall)
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-wipe-ford =;(f (f !<(_+<.f vase)) poke-wipe-ford)
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-goad-gall)
%kiln-gall-sear =;(f (f !<(_+<.f vase)) poke-gall-sear)
%kiln-wash-gall =;(f (f !<(_+<.f vase)) poke-wash-gall)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-start-autoload =;(f (f !<(_+<.f vase)) poke-start-autoload)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
==
::
++ autoload
|%
++ emit
|= a/card:agent:gall
+>(..autoload (^emit a))
::
++ tracked-vanes
^- (list @tas)
~[%ames %behn %clay %dill %eyre %ford %gall %iris %jael]
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
++ hash-vane
|= syd/@tas ^- (pair term @uvI)
[syd (sys-hash /vane/[syd]/hoon)]
::
++ rehash-vanes
^+ cur-vanes
(malt (turn tracked-vanes hash-vane))
::
::
++ poke
|= lod/(unit ?)
?^ lod
..autoload(autoload-on u.lod)
=. autoload-on !autoload-on
(spam leaf+"turned autoload {?:(autoload-on "on" "off")}" ~)
::
++ start
=. cur-hoon (sys-hash /hoon/hoon)
=. cur-arvo (sys-hash /arvo/hoon)
=. cur-zuse (sys-hash /zuse/hoon)
=. cur-vanes rehash-vanes
subscribe-next
::
++ subscribe-next
%- emit
[%pass /kiln/autoload %arvo %c [%warp our %home `[%next %z da+now /sys]]]
::
++ writ =>(check-new subscribe-next)
++ check-new
?. autoload-on
..check-new
=/ new-hoon (sys-hash /hoon/hoon)
=/ new-arvo (sys-hash /arvo/hoon)
?: |(!=(new-hoon cur-hoon) !=(new-arvo cur-arvo))
=. cur-hoon new-hoon
=. cur-arvo new-arvo
=. cur-vanes rehash-vanes
(emit %pass /kiln/reload/hoon %agent [our %hood] %poke %helm-reset !>(~))
:: XX updates cur-vanes?
=/ new-zuse (sys-hash /zuse/hoon)
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes rehash-vanes
=/ =cage [%helm-reload !>([%zuse tracked-vanes])]
(emit [%pass /kiln/reload/zuse %agent [our %hood] %poke cage])
(roll tracked-vanes load-vane)
::
++ load-vane
=< %_(. con ..load-vane)
|: $:{syd/@tas con/_.}
=. +>.$ con
=/ new-vane q:(hash-vane syd)
?: =(`new-vane (~(get by cur-vanes) syd))
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
=/ =cage [%helm-reload !>(~[syd])]
(emit %pass /kiln/reload/[syd] %agent [our %hood] %poke cage)
::
++ coup-reload
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
+>.$
--
::
++ poke-overload
:: +poke-overload: wipes ford cache at {start}, and then every {recur}.
|= [recur=@dr start=@da]
?> (gte start now)
abet:(emit %pass /kiln/overload/(scot %dr recur) %arvo %b [%wait start])
::
++ poke-wipe-ford
|=(percent=@ud abet:(emit %pass /kiln %arvo %f [%wipe percent]))
::
++ poke-keep-ford
|= [compiler-cache-size=@ud build-cache-size=@ud]
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %pass /kiln %arvo %g %goad force agent)
@ -319,8 +434,6 @@
|= =ship
abet:(emit %pass /kiln %arvo %g %sear ship)
::
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %g [%wash ~]))
::
++ done
|= {way/wire saw/(unit error:ames)}
~? ?=(^ saw) [%kiln-nack u.saw]
@ -331,33 +444,27 @@
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
(take-coup-fancy t.t.wire p.sign)
[%kiln %reload *] ?> ?=(%poke-ack -.sign)
(take-coup-reload t.t.wire p.sign)
[%kiln %spam *] ?> ?=(%poke-ack -.sign)
(take-coup-spam t.t.wire p.sign)
==
::
++ take-general
++ take-arvo
|= [=wire =sign-arvo]
?- wire
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%autoload *] %+ take-writ-autoload t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%find-ship *] %+ take-writ-find-ship t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%sync *] %+ take-writ-sync t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%overload *] %+ take-wake-overload t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%ota *] abet:(take:update t.wire sign-arvo)
*
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
?+ +<.sign-arvo
((slog leaf+"kiln: strange card {<+<.sign-arvo wire>}" ~) abet)
%done %+ done wire
?>(?=(%done +<.sign-arvo) +>.sign-arvo)
%made %+ take-made wire
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
@ -367,26 +474,10 @@
|= {way/wire are/(each (set path) (pair term tang))}
abet:abet:(mere:(take way) are)
::
++ take-made
|= [way=wire date=@da result=made-result:ford]
:: hack for |overload
::
:: We might have gotten an ignorable response back for our cache priming
:: ford call. If it matches our magic wire, ignore it.
::
?: =(/prime/cache way)
~& %cache-primed
abet
abet:abet:(made:(take way) date result)
::
++ take-coup-fancy ::
|= {way/wire saw/(unit tang)}
abet:abet:(coup-fancy:(take way) saw)
::
++ take-coup-reload ::
|= {way/wire saw/(unit tang)}
abet:(coup-reload:autoload way saw)
::
++ take-coup-spam ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-spam-lame u.saw]
@ -400,6 +491,8 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
abet:abet:(mere:(auto hos) mes)
::
++ take-writ-find-ship ::
@ -410,6 +503,8 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
?. (~(has by syn) hos)
abet
abet:abet:(take-find-ship:(auto hos) rot)
::
++ take-writ-sync ::
@ -420,24 +515,9 @@
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ take-writ-autoload
|= {way/wire rot/riot}
?> ?=(~ way)
?> ?=(^ rot)
abet:writ:autoload
::
++ take-wake-overload
|= {way/wire error=(unit tang)}
?^ error
%- (slog u.error)
~& %kiln-take-wake-overload-fail
?. (~(has by syn) hos)
abet
?> ?=({@ ~} way)
=+ tym=(slav %dr i.way)
~& %wake-overload-deprecated
abet
abet:abet:(writ:(auto hos) rot)
::
++ take-wake-autocommit
|= [way=wire error=(unit tang)]
@ -526,7 +606,7 @@
.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
?: =(0 ud.cass)
%init
?:((gth 3 ud.cass) %that %mate)
?:((gth 2 ud.cass) %that %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
@ -534,7 +614,7 @@
::
++ mere
|= mes=(each (set path) (pair term tang))
?: ?=([%| %bad-fetch-ali *] mes)
?: ?=([%| %ali-unavailable *] mes)
=. +>.$
%^ spam
leaf+"merge cancelled, maybe because sunk; restarting"
@ -585,15 +665,6 @@
~| %kiln-work-fail
.
::
++ ford-fail
|=(tan/tang ~|(%ford-fail (mean tan)))
::
++ unwrap-tang
|* res/(each * tang)
?: ?=(%& -.res)
p.res
(ford-fail p.res)
::
++ perform ::
^+ .
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
@ -621,10 +692,7 @@
++ coup-fancy
|= saw/(unit tang)
?~ saw
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
+>
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
lose:(spam leaf+-< leaf+-> u.saw)
@ -638,35 +706,60 @@
=+ "merged with strategy {<gem>}"
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
:: ~? > =(~ p.are) [%mere-no-conflict syd]
=+ "mashing conflicts"
=> .(+>.$ (spam leaf+- ~))
=> .(+>.$ (spam leaf+"mashing conflicts" ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
=, ford
:* %pass /kiln/[syd] %arvo %f
:* %build live=%.n
^- schematic
:- %list
^- (list schematic)
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
%+ turn ~(tap in p.are)
|= pax/path
^- [schematic schematic]
:- [%$ %path -:!>(*path) pax]
=/ base=schematic [%scry %c %x `rail`[[our tic] (flop pax)]]
?> ?=([%da @] cas)
=/ alis=schematic
[%pin p.cas `schematic`[%scry %c %x [[our syd] (flop pax)]]]
=/ bobs=schematic
[%scry %c %x [[our syd] (flop pax)]]
=/ dali=schematic [%diff [our syd] base alis]
=/ dbob=schematic [%diff [our syd] base bobs]
=/ for=mark
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
^- schematic
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
== ==
=/ notations=(list [path (unit [mark vase])])
%+ turn ~(tap in p.are)
|= =path
=/ =mark -:(flop path)
=/ =dais .^(dais %cb /(scot %p our)/[syd]/(scot cas)/[mark])
=/ base .^(vase %cr (weld /(scot %p our)/[tic]/(scot cas) path))
=/ ali .^(vase %cr (weld /(scot %p her)/[sud]/(scot cas) path))
=/ bob .^(vase %cr (weld /(scot %p our)/[syd]/(scot cas) path))
=/ ali-dif (~(diff dais base) ali)
=/ bob-dif (~(diff dais base) bob)
=/ mash (~(mash dais base) [her sud ali-dif] [our syd bob-dif])
:- path
?~ mash
~
`[mark (~(pact dais base) u.mash)]
=/ [annotated=(list [path *]) unnotated=(list [path *])]
(skid notations |=([* v=*] ?=(^ v)))
=/ tic=desk (cat 3 syd '-scratch')
=/ tan=(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[tic]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[tic]>}
"""
%^ tanks-if-any
"annotated conflicts in:" (turn annotated head)
""
%^ tanks-if-any
"unannotated conflicts in:" (turn unnotated head)
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
:* %pass /kiln/[syd] %arvo %c
%info
tic %&
%+ murn notations
|= [=path dif=(unit [=mark =vase])]
^- (unit [^path miso])
?~ dif
~
`[path %mut mark.u.dif vase.u.dif]
==
=+ "failed to merge with strategy meld"
lose:(spam leaf+- >p.p.are< q.p.are)
?: ?=(%& -.are)
@ -706,7 +799,11 @@
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
(fancy-merge tic our syd %init)
=. ..mere (fancy-merge tic our syd %init)
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
%- blab :_ ~
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
==
::
++ tape-to-tanks
@ -717,68 +814,5 @@
|= {a/tape b/(list path) c/tape} ^- (list tank)
?: =(~ b) ~
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
::
++ made
|= [date=@da result=made-result:ford]
:: |= {dep/@uvH reg/gage:ford}
^+ +>
::
?: ?=([%incomplete *] result)
=+ "failed to mash"
lose:(spam leaf+- tang.result)
?: ?=([%complete %error *] result)
=+ "failed to mash"
lose:(spam leaf+- message.build-result.result)
?> ?=([%complete %success %list *] result)
=/ can=(list (pair path (unit miso)))
%+ turn results.build-result.result
|= res=build-result:ford
^- (pair path (unit miso))
?> ?=([%success ^ *] res)
~! res
=+ pax=(result-to-cage:ford head.res)
=+ dif=(result-to-cage:ford tail.res)
::
?. ?=($path p.pax)
~| "strange path mark: {<p.pax>}"
!!
[;;(path q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])]
:: ~& > kiln-made+[(turn can head) syd=syd +<.abet]
=+ notated=(skid can |=({path a/(unit miso)} ?=(^ a)))
=+ annotated=(turn `(list (pair path *))`-.notated head)
=+ unnotated=(turn `(list (pair path *))`+.notated head)
=+ `desk`(cat 3 syd '-scratch')
=/ tan=(list tank)
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[-]>}
please resolve the following conflicts and run
|merge {<syd>} our {<[-]>}
"""
%^ tanks-if-any
"annotated conflicts in:" annotated
""
%^ tanks-if-any
"unannotated conflicts in:" unnotated
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
:* %pass /kiln/[syd] %arvo %c
:* %info
(cat 3 syd '-scratch') %&
%+ murn can
|= {p/path q/(unit miso)}
`(unit (pair path miso))`?~(q ~ `[p u.q])
== ==
--
--

143
pkg/arvo/lib/hood/write.hoon
View File

@ -1,143 +0,0 @@
:: File writer module
::
:::: /hoon/write/hood/lib
::
/? 310
=, format
=* as-octs as-octs:mimes:html
=, space:userlib
|%
+$ part {$write $0 pith} :: no state
+$ pith ~
--
::
::::
::
|%
++ data $%({$json json} {$mime mime})
--
::
::::
::
|= {bowl:gall part}
=* par +<+
|_ moz/(list card:agent:gall)
++ abet [(flop moz) `part`par]
++ emit
|= =card:agent:gall
%_(+> moz :_(moz card))
::
++ beak-now byk(r [%da now])
++ poke-wipe
|= sup/path ^+ abet :: XX determine extension, beak
=+ ext=%md
?~ (file (en-beam beak-now [ext sup]))
~|(not-found+[ext `path`(flop sup)] !!)
=- abet:(emit %pass /write %arvo %c %info -)
(fray (en-beam beak-now [ext sup]))
::
++ poke-tree
|= {sup/path mim/mime} ^+ abet :: XX determine extension, beak
(poke--data [`%md (flop sup)] %mime mim)
::
++ poke-paste
|= {typ/?($hoon $md $txt) txt/@t} ^+ abet
(poke--data [`typ /web/paste/(scot %da now)] %mime / (as-octs txt))
::
++ poke-comment
|= {sup/path him/ship txt/@t} ^+ abet
=+ pax=(welp (flop sup) /comments/(scot %da now))
=. txt
%+ rap 3 :~
'## `' (scot %p him) '`'
'\0a' txt
==
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ poke-fora-post
|= {sup/path him/ship hed/@t txt/@t} ^+ abet
=+ pax=(welp (flop sup) /posts/(cat 3 (scot %da now) '~'))
=. txt
%- crip
"""
---
type: post
date: {<now>}
title: {(trip hed)}
author: {<him>}
navsort: bump
navuptwo: true
comments: reverse
---
{(trip txt)}
"""
(poke--data [`%md pax] %mime / (as-octs txt))
::
++ ames-secret
^- @t
=- (crip +:<.^(@p %j pax)>)
pax=/(scot %p our)/code/(scot %da now)/(scot %p our)
::
++ poke-sec-atom
|= {hot/host:eyre dat/@}
?> ?=(%& -.hot)
=. p.hot (scag 2 p.hot) :: ignore subdomain
=. dat (scot %uw (en:crub:crypto ames-secret dat))
(poke--data [`%atom [%sec p.hot]] %mime / (as-octs dat))
::
++ poke--data
|= {{ext/(unit @t) pax/path} dat/data} ^+ abet
?~ ext $(ext [~ -.dat])
=+ cay=?-(-.dat $json [-.dat !>(+.dat)], $mime [-.dat !>(+.dat)])
?: =(u.ext -.dat)
(made pax now [%complete %success %$ cay])
=< abet
%- emit :*
%pass write+pax %arvo %f
%build
live=%.n :: XX defer %nice
^- schematic:ford :: SYNTAX ERROR AT START OF LINE?
=/ =beak beak-now
[%cast [p q]:beak u.ext [%$ cay]]
==
::
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-write-bad-mark mark] !!)
%write-sec-atom =;(f (f !<(_+<.f vase)) poke-sec-atom)
%write-paste =;(f (f !<(_+<.f vase)) poke-paste)
%write-tree =;(f (f !<(_+<.f vase)) poke-tree)
%write-wipe =;(f (f !<(_+<.f vase)) poke-wipe)
==
::
++ made
|= [pax=wire date=@da result=made-result:ford]
^+ abet
:: |= {pax/wire @ res/gage:ford} ^+ abet
:: ?. =(our src)
:: ~|(foreign-write/[our=our src=src] !!)
?: ?=(%incomplete -.result)
(mean tang.result)
::
=/ build-result build-result.result
::
?: ?=([%error *] build-result)
(mean message.build-result)
::
=/ =cage (result-to-cage:ford build-result)
::
=- abet:(emit %pass /write %arvo %c %info -)
::
(foal :(welp (en-beam beak-now ~) pax /[-.cage]) cage)
::
++ take ::
|= [=wire =sign-arvo]
%+ made wire
?> ?=(%made +<.sign-arvo)
+>.sign-arvo
::
++ take-agent
|= [=wire =sign:agent:gall]
~|([%write-bad-take-agent wire -.sign] !!)
--

20
pkg/arvo/lib/language-server/complete.hoon
View File

@ -248,15 +248,15 @@
::
++ get-id
|= [pos=@ud txt=tape]
^- [forward=(unit term) backward=(unit term) id=(unit term)]
=/ forward=(unit term)
%+ scan `tape`(slag pos txt)
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
=/ backward=(unit term)
^- [forward=(unit @t) backward=(unit @t) id=(unit @t)]
=/ seek
;~(sfix (punt (cook crip (star prn))) (star ;~(pose prn (just `@`10))))
=/ forward=(unit @t)
(scan (slag pos txt) seek)
=/ backward=(unit @t)
%- (lift |=(t=@tas (swp 3 t)))
%+ scan `tape`(flop (scag pos txt))
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
=/ id=(unit term)
(scan (flop (scag pos txt)) seek)
=/ id=(unit @t)
?~ forward
?~ backward
~
@ -338,13 +338,13 @@
~? > debug %start-magick
=/ magicked txt:(insert-magic pos code)
~? > debug %start-parsing
=/ res (lily magicked (language-server-parser *beam))
=/ res (lily magicked (language-server-parser *path))
?: ?=(%| -.res)
~? > debug [%parsing-error p.res]
[%| p.res]
:- %&
~? > debug %parsed-good
((cury tab-list-hoon sut) tssg+sources.p.res)
((cury tab-list-hoon sut) hoon.p.res)
::
:: Generators
++ tab-generators

267
pkg/arvo/lib/language-server/parser.hoon
View File

@ -1,204 +1,85 @@
:: lifted directly from ford, should probably be in zuse
=< parse-scaffold
=, ford
=, clay
=< pile-rule
|%
++ parse-scaffold
|= src-beam=beam
::
=/ hoon-parser (vang & (en-beam:format src-beam))
|^ ::
%+ cook
|= a=[@ud (list ^cable) (list ^cable) (list ^crane) (list hoon)]
^- scaffold
[[[p q] s]:src-beam a]
::
%+ ifix [gay gay]
;~ plug
:: parses the zuse version, eg "/? 309"
::
;~ pose
(ifix [;~(plug net wut gap) gap] dem)
(easy zuse)
==
:: pareses the structures, eg "/- types"
::
;~ pose
(ifix [;~(plug net hep gap) gap] (most ;~(plug com gaw) cable))
(easy ~)
==
:: parses the libraries, eg "/+ lib1, lib2"
::
;~ pose
(ifix [;~(plug net lus gap) gap] (most ;~(plug com gaw) cable))
(easy ~)
==
::
(star ;~(sfix crane gap))
::
(most gap tall:hoon-parser)
==
:: +beam: parses a hood path and converts it to a beam
::
++ beam
%+ sear de-beam:format
;~ pfix
net
(sear plex (stag %clsg poor)):hoon-parser
==
:: +cable: parses a +^cable, a reference to something on the filesystem
::
:: This parses:
::
:: `library` -> wraps `library` around the library `library`
:: `face=library` -> wraps `face` around the library `library`
:: `*library` -> exposes `library` directly to the subject
::
++ cable
%+ cook |=(a=^cable a)
++ pile-rule
|= pax=path
%- full
%+ ifix [gay gay]
%+ cook |=(pile +<)
;~ pfix
:: parse optional /? and ignore
::
;~ pose
(stag ~ ;~(pfix tar sym))
(cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym))
(cook |=(a=term [`a a]) sym)
(cold ~ ;~(plug net wut gap dem gap))
(easy ~)
==
:: +crane: all runes that start with / which aren't /?, /-, /+ or //.
::
++ crane
=< apex
:: whether we allow tall form
=| allow-tall-form=?
::
|%
++ apex
%+ knee *^crane |. ~+
;~ pfix net
;~ pose
:: `/~` hoon literal
::
(stag %fssg ;~(pfix sig hoon))
:: `/$` process query string
::
(stag %fsbc ;~(pfix bus hoon))
:: `/|` first of many options that succeeds
::
(stag %fsbr ;~(pfix bar parse-alts))
:: `/=` wrap a face around a crane
::
(stag %fsts ;~(pfix tis parse-face))
:: `/.` null terminated list
::
(stag %fsdt ;~(pfix dot parse-list))
:: `/,` switch by path
::
(stag %fscm ;~(pfix com parse-switch))
:: `/&` pass through a series of mark
::
(stag %fspm ;~(pfix pad parse-pipe))
:: `/_` run a crane on each file in the current directory
::
(stag %fscb ;~(pfix cab subcrane))
:: `/;` passes date through a gate
::
(stag %fssm ;~(pfix mic parse-gate))
:: `/:` evaluate at path
::
(stag %fscl ;~(pfix col parse-at-path))
:: `/^` cast
::
(stag %fskt ;~(pfix ket parse-cast))
:: `/*` run a crane on each file with current path as prefix
::
(stag %fstr ;~(pfix tar subcrane))
:: `/!mark/ evaluate as hoon, then pass through mark
::
(stag %fszp ;~(pfix zap ;~(sfix sym net)))
:: `/mark/` passes current path through :mark
::
(stag %fszy ;~(sfix sym net))
;~ plug
;~ pose
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net hep gap)
(most ;~(plug com gaw) taut-rule)
==
gap
==
(easy ~)
==
:: +parse-alts: parse a set of alternatives
::
++ parse-alts
%+ wide-or-tall
(ifix [lit rit] (most ace subcrane))
;~(sfix (star subcrane) gap duz)
:: +parse-face: parse a face around a subcrane
::
++ parse-face
%+ wide-or-tall
;~(plug sym ;~(pfix tis subcrane))
;~(pfix gap ;~(plug sym subcrane))
:: +parse-list: parse a null terminated list of cranes
::
++ parse-list
%+ wide-or-tall
fail
;~(sfix (star subcrane) gap duz)
:: +parse-switch: parses a list of [path crane]
::
++ parse-switch
%+ wide-or-tall
fail
=- ;~(sfix (star -) gap duz)
;~(pfix gap net ;~(plug static-path subcrane))
:: +parse-pipe: parses a pipe of mark conversions
::
++ parse-pipe
%+ wide-or-tall
;~(plug (plus ;~(sfix sym pad)) subcrane)
=+ (cook |=(a=term [a ~]) sym)
;~(pfix gap ;~(plug - subcrane))
:: +parse-gate: parses a gate applied to a crane
::
++ parse-gate
%+ wide-or-tall
;~(plug ;~(sfix wide:hoon-parser mic) subcrane)
;~(pfix gap ;~(plug tall:hoon-parser subcrane))
:: +parse-at-path: parses a late bound bath
::
++ parse-at-path
%+ wide-or-tall
;~(plug ;~(sfix late-bound-path col) subcrane)
;~(pfix gap ;~(plug late-bound-path subcrane))
:: +parse-cast: parses a mold and then the subcrane to apply that mold to
::
++ parse-cast
%+ wide-or-tall
;~(plug ;~(sfix wyde:hoon-parser ket) subcrane)
;~(pfix gap ;~(plug till:hoon-parser subcrane))
:: +subcrane: parses a subcrane
::
++ subcrane
%+ wide-or-tall
apex(allow-tall-form |)
;~(pfix gap apex)
:: +wide-or-tall: parses tall form hoon if :allow-tall-form is %.y
::
++ wide-or-tall
|* [wide=rule tall=rule]
?. allow-tall-form wide
;~(pose wide tall)
:: +hoon: parses hoon as an argument to a crane
::
++ hoon
%+ wide-or-tall
(ifix [lac rac] (stag %cltr (most ace wide:hoon-parser)))
;~(pfix gap tall:hoon-parser)
--
:: +static-path: parses a path
::
++ static-path
(sear plex (stag %clsg (more net hasp))):hoon-parser
:: +late-bound-path: a path whose time varies
::
++ late-bound-path
;~ pfix net
%+ cook |=(a=truss a)
=> hoon-parser
;~ plug
(stag ~ gash)
;~(pose (stag ~ ;~(pfix cen porc)) (easy ~))
;~ pose
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net lus gap)
(most ;~(plug com gaw) taut-rule)
==
gap
==
(easy ~)
==
::
;~ pose
;~ sfix
%+ cook |=((list [face=term =path]) +<)
%+ more gap
;~ pfix ;~(plug net tis gap)
%+ cook |=([term path] +<)
;~(plug sym ;~(pfix ;~(plug gap net) (more net urs:ab)))
==
gap
==
(easy ~)
==
::
;~ pose
;~ sfix
%+ cook |=((list [face=term =mark =path]) +<)
%+ more gap
;~ pfix ;~(plug net tar gap)
%+ cook |=([term mark path] +<)
;~ plug
sym
;~(pfix ;~(plug gap cen) sym)
;~(pfix ;~(plug gap net) (more net urs:ab))
==
==
gap
==
(easy ~)
==
::
%+ cook |=(huz=(list hoon) `hoon`tssg+huz)
(most gap tall:(vang & pax))
==
--
==
::
++ taut-rule
%+ cook |=(taut +<)
;~ pose
(stag ~ ;~(pfix tar sym))
;~(plug (stag ~ sym) ;~(pfix tis sym))
(cook |=(a=term [`a a]) sym)
==
--

11
pkg/arvo/lib/link.hoon → pkg/arvo/lib/link-store.hoon
View File

@ -1,7 +1,10 @@
:: link: social bookmarking
::
/- *link
/- sur=link-store, *link
::
^?
=< [. sur]
=, sur
|%
++ site-from-url
|= =url
@ -92,8 +95,9 @@
[a b]
--
::
++ en-json
++ enjs
=, enjs:format
^?
|%
++ update
|= upd=^update
@ -166,8 +170,9 @@
==
--
::
++ de-json
++ dejs
=, dejs:format
^?
|%
:: +action: json into action
::

29
pkg/arvo/lib/ph/io.hoon
View File

@ -46,7 +46,11 @@
:: probably the best option because the thread can delay until it
:: gets a positive ack on the subscription.
::
;< ~ bind:m (sleep ~s0)
:: Threads might not get built until a %writ is dripped back to
:: spider. Drips are at +(now), so we sleep until two clicks in the
:: future.
::
;< ~ bind:m (sleep `@dr`2)
(pure:m ~)
::
++ end-test
@ -150,7 +154,7 @@
:: hit the first of these cases, and other ships will hit the
:: second.
::
?: ?| (f "clay: committed initial filesystem (all)")
?: ?| (f ":dojo>")
(f "is your neighbor")
==
(pure:m ~)
@ -212,13 +216,18 @@
|= [her=ship =desk extra=@t]
=/ m (strand ,@t)
^- form:m
(touch her desk /sur/aquarium/hoon extra)
::
:: Modify path on the given ship
::
++ touch
|= [her=ship =desk pax=path extra=@t]
=/ m (strand ,@t)
^- form:m
~& > "touching file on {<her>}/{<desk>}"
;< ~ bind:m (mount her desk)
;< our=@p bind:m get-our
;< now=@da bind:m get-time
=/ host-pax
/(scot %p our)/home/(scot %da now)/sur/aquarium/hoon
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[desk]/(scot %da now)
@ -229,7 +238,7 @@
%^ cat 3 '=> . '
%^ cat 3 extra
(need (scry-aqua:util (unit @) our now aqua-pax))
;< ~ bind:m (send-events (insert-file:util her desk host-pax warped))
;< ~ bind:m (send-events (insert-files:util her desk [pax warped] ~))
(pure:m warped)
::
:: Check /sur/aquarium/hoon on the given has the given contents.
@ -237,6 +246,13 @@
++ check-file-touched
|= [=ship =desk warped=@t]
=/ m (strand ,~)
(check-touched ship desk /sur/aquarium/hoon warped)
::
:: Check path on the given desk has the given contents.
::
++ check-touched
|= [=ship =desk pax=path warped=@t]
=/ m (strand ,~)
~& > "checking file touched on {<ship>}/{<desk>}"
;< ~ bind:m (mount ship desk)
^- form:m
@ -250,7 +266,6 @@
::
?. &(=(ship her) ?=(?(%init %ergo %doze) -.q.unix-effect))
loop
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p ship)/cx/(scot %p ship)/[desk]/(scot %da now)

12
pkg/arvo/lib/ph/util.hoon
View File

@ -45,14 +45,16 @@
::
:: Inject a file into a ship
::
++ insert-file
|= [who=ship des=desk pax=path txt=@t]
++ insert-files
|= [who=ship des=desk files=(list [=path txt=@t])]
^- (list aqua-event)
?> ?=([@ @ @ *] pax)
=/ file [/text/plain (as-octs:mimes:html txt)]
=/ input
%+ turn files
|= [=path txt=@t]
[path ~ /text/plain (as-octs:mimes:html txt)]
%+ send-events-to who
:~
[//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~]
[//sync/0v1n.2m9vh %into des | input]
==
::
:: Checks whether the given event is a dojo output blit containing the

77
pkg/arvo/lib/pill.hoon
View File

@ -2,12 +2,12 @@
::
^?
|%
:: +module-ova: vane load operations.
::
:: sys: full path to /sys directory
::
+$ pill
[boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)]
$: boot-ova=*
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
==
::
+$ unix-event
%+ pair wire
@ -16,42 +16,24 @@
[%boot ? $%($>(%fake task:able:jael) $>(%dawn task:able:jael))]
unix-task
==
:: +module-ova: vane load operations
::
:: sys: full path to /sys directory
::
++ module-ova
|= sys=path
^- (list [wire [%veer term path cord]])
%+ turn
^- (list (pair term path))
:~ :: sys/zuse: standard library
::
[%$ /zuse]
:: sys/vane/ames: network
::
[%a /vane/ames]
:: sys/vane/behn: timer
::
[%b /vane/behn]
:: sys/vane/clay: revision control
::
[%c /vane/clay]
:: sys/vane/dill: console
::
[%d /vane/dill]
:: sys/vane/eyre: http server
::
[%e /vane/eyre]
:: sys/vane/ford: build
::
[%f /vane/ford]
:: sys/vane/gall: applications
::
[%g /vane/gall]
:: sys/vane/iris: http client
::
[%i /vane/iris]
:: sys/vane/kale: security
::
[%j /vane/jael]
:~ [%$ /zuse] :: standard library
[%a /vane/ames] :: network
[%b /vane/behn] :: timer
[%c /vane/clay] :: revision control
[%d /vane/dill] :: console
[%e /vane/eyre] :: http server
[%g /vane/gall] :: applications
[%i /vane/iris] :: http client
[%j /vane/jael] :: identity and security
==
|= [=term =path]
=/ pax (weld sys path)
@ -59,25 +41,22 @@
[[%vane path] [%veer term pax txt]]
:: +file-ovum: userspace filesystem load
::
:: bas: full path to / directory
:: bas: full path to / directory
::
++ file-ovum
=/ directories
`(list path)`~[/app /ted /gen /lib /mar /ren /sec /sur /sys /tests /web]
=/ directories=(list path)
:~ /app :: %gall applications
/gen :: :dojo generators
/lib :: libraries
/mar :: mark definitions
/sur :: structures
/sys :: system files
/ted :: :spider strands
/tests :: unit tests
/web :: %eyre web content
==
|= bas=path
^- unix-event
::
:: /app %gall applications
:: /gen :dojo generators
:: /lib %ford libraries
:: /mar %ford marks
:: /ren %ford renderers
:: /sec %eyre security drivers
:: /sur %ford structures
:: /sys system files
:: /tests unit tests
:: /web %eyre web content
::
%. directories
|= :: sal: all spurs to load from
::

45
pkg/arvo/lib/shoe.hoon
View File

@ -35,14 +35,20 @@
|* command-type=mold
$_ ^|
|_ bowl:gall
:: +command-parser: input parser for a specific session
::
:: if the head of the result is true, instantly run the command
::
++ command-parser
|~ sole-id=@ta
|~(nail *(like command-type))
|~(nail *(like [? command-type]))
:: +tab-list: autocomplete options for the session (to match +command-parser)
::
++ tab-list
|~ sole-id=@ta
:: (list [@t tank])
*(list (option:auto tank))
:: +on-command: called when a valid command is run
::
++ on-command
|~ [sole-id=@ta command=command-type]
@ -106,9 +112,11 @@
|* [shoe=* command-type=mold]
|_ =bowl:gall
++ command-parser
(easy *command-type)
|= sole-id=@ta
(easy *[? command-type])
::
++ tab-list
|= sole-id=@ta
~
::
++ on-command
@ -193,9 +201,9 @@
(~(gut by soles) sole-id *sole-share)
|^ =^ [cards=(list card) =_cli-state] shoe
?- -.dat.act
%det [(apply-edit +.dat.act) shoe]
%det (apply-edit +.dat.act)
%clr [[~ cli-state] shoe]
%ret run-command
%ret try-command
%tab [(tab +.dat.act) shoe]
==
:- (deal cards)
@ -208,15 +216,19 @@
::
++ apply-edit
|= =sole-change
^- (quip card _cli-state)
^+ [[*(list card) cli-state] shoe]
=^ inverse cli-state
(~(transceive sole cli-state) sole-change)
:: res: & for fully parsed, | for parsing failure at location
::
=/ res=(each (unit) @ud)
=/ res=(each (unit [run=? cmd=command-type]) @ud)
%+ rose (tufa buf.cli-state)
(command-parser:og sole-id)
?: ?=(%& -.res) [~ cli-state]
?: ?=(%& -.res)
?. &(?=(^ p.res) run.u.p.res)
[[~ cli-state] shoe]
(run-command cmd.u.p.res)
:_ shoe
:: parsing failed
::
?. &(?=(%del -.inverse) =(+(p.inverse) (lent buf.cli-state)))
@ -234,14 +246,18 @@
[%err p.res] :: cursor to error location
==
::
++ run-command
++ try-command
^+ [[*(list card) cli-state] shoe]
=/ cmd=(unit command-type)
=/ res=(unit [? cmd=command-type])
%+ rust (tufa buf.cli-state)
(command-parser:og sole-id)
?~ cmd
[[[(effect %bel ~)]~ cli-state] shoe]
=^ cards shoe (on-command:og sole-id u.cmd)
?^ res (run-command cmd.u.res)
[[[(effect %bel ~)]~ cli-state] shoe]
::
++ run-command
|= cmd=command-type
^+ [[*(list card) cli-state] shoe]
=^ cards shoe (on-command:og sole-id cmd)
:: clear buffer
::
=^ clear cli-state (~(transmit sole cli-state) [%set ~])
@ -251,7 +267,6 @@
[%det clear]
==
::
::NOTE cargo-culted
++ tab
|= pos=@ud
^- (quip card _cli-state)
@ -271,7 +286,9 @@
%+ add pos
(met 3 (fall forward ''))
=| cards=(list card)
=? cards ?=(^ options)
:: only render the option list if we couldn't complete anything
::
=? cards &(?=(~ to-send) ?=(^ options))
[(effect %tab options) cards]
|- ^- (quip card _cli-state)
?~ to-send

111
pkg/arvo/lib/strandio.hoon
View File

@ -26,6 +26,12 @@
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-beak
=/ m (strand ,beak)
^- form:m
|= tin=strand-input:strand
`[%done [our q.byk da+now]:bowl.tin]
::
++ get-time
=/ m (strand ,@da)
^- form:m
@ -360,14 +366,20 @@
?> ?=(^ full-file.client-response)
(pure:m q.data.u.full-file.client-response)
::
++ fetch-json
++ fetch-cord
|= url=tape
=/ m (strand ,json)
=/ m (strand ,cord)
^- form:m
=/ =request:http [%'GET' (crip url) ~ ~]
;< ~ bind:m (send-request request)
;< =client-response:iris bind:m take-client-response
;< =cord bind:m (extract-body client-response)
(extract-body client-response)
::
++ fetch-json
|= url=tape
=/ m (strand ,json)
^- form:m
;< =cord bind:m (fetch-cord url)
=/ json=(unit json) (de-json:html cord)
?~ json
(strand-fail %json-parse-error ~)
@ -380,6 +392,93 @@
;< ~ bind:m (send-request (hiss-to-request:html hiss))
take-maybe-sigh
::
:: +build-fail: build the source file at the specified $beam
::
++ build-file
|= [[=ship =desk =case] =spur]
=* arg +<
=/ m (strand ,vase)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %a case (flop spur))
?~ riot
(strand-fail %build-file >arg< ~)
?> =(%vase p.r.u.riot)
(pure:m !<(vase q.r.u.riot))
:: +build-mark: build a mark definition to a $dais
::
++ build-mark
|= [[=ship =desk =case] mak=mark]
=* arg +<
=/ m (strand ,dais:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak])
?~ riot
(strand-fail %build-mark >arg< ~)
?> =(%dais p.r.u.riot)
(pure:m !<(dais:clay q.r.u.riot))
:: +build-cast: build a mark conversion gate ($tube)
::
++ build-cast
|= [[=ship =desk =case] =mars:clay]
=* arg +<
=/ m (strand ,tube:clay)
^- form:m
;< =riot:clay bind:m
(warp ship desk ~ %sing %c case /[a.mars]/[b.mars])
?~ riot
(strand-fail %build-cast >arg< ~)
?> =(%tube p.r.u.riot)
(pure:m !<(tube:clay q.r.u.riot))
::
:: Read from Clay
::
++ warp
|= [=ship =riff:clay]
=/ m (strand ,riot:clay)
;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff)
(take-writ /warp)
::
++ read-file
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,cage)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case (flop spur))
?~ riot
(strand-fail %read-file >arg< ~)
(pure:m r.u.riot)
::
++ check-for-file
|= [[=ship =desk =case:clay] =spur]
=/ m (strand ,?)
;< =riot:clay bind:m (warp ship desk ~ %sing %x case (flop spur))
(pure:m ?=(^ riot))
::
++ list-tree
|= [[=ship =desk =case:clay] =spur]
=* arg +<
=/ m (strand ,(list path))
;< =riot:clay bind:m (warp ship desk ~ %sing %t case (flop spur))
?~ riot
(strand-fail %list-tree >arg< ~)
(pure:m !<((list path) q.r.u.riot))
::
:: Take Clay read result
::
++ take-writ
|= =wire
=/ m (strand ,riot:clay)
^- form:m
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign * ?(%b %c) %writ *]
?. =(wire wire.u.in.tin)
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop
@ -487,6 +586,12 @@
;< ~ bind:m (flog-text i.wall)
loop(wall t.wall)
::
++ trace
|= =tang
=/ m (strand ,~)
^- form:m
(pure:m ((slog tang) ~))
::
++ app-message
|= [app=term =cord =tang]
=/ m (strand ,~)

267
pkg/arvo/lib/test/ford-external.hoon
View File

@ -1,267 +0,0 @@
/+ *test
=, ford
|%
:: +expect-schematic: assert a +schematic:ford is what we expect
::
:: Since Ford requests contain types, we can't do simple
:: equality checking. This function handles all the different
:: kinds of +schematic:ford, dealing with types as necessary.
::
++ expect-schematic
|= [expected=schematic actual=schematic]
^- tang
::
?^ -.expected
?. ?=(^ -.actual)
[%leaf "expected autocons, but got {<-.actual>}"]~
::
%+ weld
$(expected head.expected, actual head.actual)
$(expected tail.expected, actual tail.actual)
::
?- -.expected
%$
?. ?=(%$ -.actual)
[%leaf "expected %$, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(p.literal.expected) !>(p.literal.actual))
(expect-eq q.literal.expected q.literal.actual)
::
%pin
::
?. ?=(%pin -.actual)
[%leaf "expected %pin, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(date.expected) !>(date.actual))
$(expected schematic.expected, actual schematic.actual)
::
%alts
::
?. ?=(%alts -.actual)
[%leaf "expected %alts, but got {<-.actual>}"]~
::
|- ^- tang
?~ choices.expected
:: make sure there aren't any extra :choices in :actual
::
?~ choices.actual
~
[%leaf "actual had more choices than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ choices.actual
[%leaf "expected had more choices than actual"]~
:: recurse on the first sub-schematic
::
%+ weld
^$(expected i.choices.expected, actual i.choices.actual)
$(choices.expected t.choices.expected, choices.actual t.choices.actual)
::
%bake
(expect-eq [schematic-type expected] [schematic-type actual])
::
%bunt
(expect-eq [schematic-type expected] [schematic-type actual])
::
%call
::
?. ?=(%call -.actual)
[%leaf "expected %call, but got {<-.actual>}"]~
::
%+ weld
$(expected gate.expected, actual gate.actual)
$(expected sample.expected, actual sample.actual)
::
%cast
::
?. ?=(%cast -.actual)
[%leaf "expected %cast, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
$(expected input.expected, actual input.actual)
==
::
%core
(expect-eq [schematic-type expected] [schematic-type actual])
::
%diff
::
?. ?=(%diff -.actual)
[%leaf "expected %diff, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
$(expected start.expected, actual start.actual)
$(expected end.expected, actual end.actual)
==
::
%dude
::
?. ?=(%dude -.actual)
[%leaf "expected %dude, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(error.expected) !>(error.actual))
$(expected attempt.expected, actual attempt.actual)
::
%hood
(expect-eq [schematic-type expected] [schematic-type actual])
::
%join
::
?. ?=(%join -.actual)
[%leaf "expected %join, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
$(expected first.expected, actual first.actual)
$(expected second.expected, actual second.actual)
==
::
%list
::
?. ?=(%list -.actual)
[%leaf "expected %list, but got {<-.actual>}"]~
::
|- ^- tang
?~ schematics.expected
:: make sure there aren't any extra :schematics in :actual
::
?~ schematics.actual
~
[%leaf "actual had more schematics than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ schematics.actual
[%leaf "expected had more schematics than actual"]~
::
%+ weld
^$(expected i.schematics.expected, actual i.schematics.actual)
::
%_ $
schematics.expected t.schematics.expected
schematics.actual t.schematics.actual
==
::
%mash
::
?. ?=(%mash -.actual)
[%leaf "expected %mash, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
(expect-eq !>(mark.expected) !>(mark.actual))
(expect-eq !>(disc.first.expected) !>(disc.first.actual))
(expect-eq !>(mark.first.expected) !>(mark.first.actual))
(expect-eq !>(disc.second.expected) !>(disc.second.actual))
(expect-eq !>(mark.second.expected) !>(mark.second.actual))
$(expected schematic.first.expected, actual schematic.first.actual)
$(expected schematic.second.expected, actual schematic.second.actual)
==
::
%mute
::
?. ?=(%mute -.actual)
[%leaf "expected %mute, but got {<-.actual>}"]~
::
%+ weld $(expected subject.expected, actual subject.actual)
::
|- ^- tang
?~ mutations.expected
:: make sure there aren't any extra :mutations in :actual
::
?~ mutations.actual
~
[%leaf "actual had more mutations than expected"]~
:: :expected isn't empty yet; make sure :actual isn't either
::
?~ mutations.actual
[%leaf "expected had more mutations than actual"]~
::
;: weld
(expect-eq !>(p.i.mutations.expected) !>(p.i.mutations.actual))
^$(expected q.i.mutations.expected, actual q.i.mutations.actual)
%_ $
mutations.expected t.mutations.expected
mutations.actual t.mutations.actual
==
==
::
%pact
::
?. ?=(%pact -.actual)
[%leaf "expected %pact, but got {<-.actual>}"]~
::
;: weld
(expect-eq !>(disc.expected) !>(disc.actual))
$(expected start.expected, actual start.actual)
$(expected diff.expected, actual diff.actual)
==
::
%path
(expect-eq [schematic-type expected] [schematic-type actual])
::
%plan
(expect-eq [schematic-type expected] [schematic-type actual])
::
%reef
(expect-eq [schematic-type expected] [schematic-type actual])
::
%ride
::
?. ?=(%ride -.actual)
[%leaf "expected %ride, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(formula.expected) !>(formula.actual))
$(expected subject.expected, actual subject.actual)
::
%same
::
?. ?=(%same -.actual)
[%leaf "expected %same, but got {<-.actual>}"]~
::
$(expected schematic.expected, actual schematic.actual)
::
%scry
(expect-eq [schematic-type expected] [schematic-type actual])
::
%slim
::
?. ?=(%slim -.actual)
[%leaf "expected %slim, but got {<-.actual>}"]~
::
%+ weld
(expect-eq !>(formula.expected) !>(formula.actual))
::
%+ expect-eq
!>(`?`%.y)
^- vase
:- -:!>(*?)
^- ?
(~(nest ut subject-type.expected) | subject-type.actual)
::
%slit
::
?. ?=(%slit -.actual)
[%leaf "expected %slit, but got {<-.actual>}"]~
::
%+ weld
(expect-eq gate.expected gate.actual)
(expect-eq sample.expected sample.actual)
::
?(%vale %volt)
(expect-eq [schematic-type expected] [schematic-type actual])
::
%walk
(expect-eq [schematic-type expected] [schematic-type actual])
==
:: +schematic-type: the +type for +schematic:ford
::
++ schematic-type ^~ `type`-:!>(*schematic:ford)
--

341
pkg/arvo/lib/test/ford.hoon
View File

@ -1,341 +0,0 @@
/+ *test
::
/= ford-vane /: /===/sys/vane/ford /!noun/
::
/= hoon-scry /: /===/sys/hoon /hoon/
/= arvo-scry /: /===/sys/arvo /hoon/
/= zuse-scry /: /===/sys/zuse /hoon/
/= txt-scry /: /===/mar/txt /hoon/
/= diff-scry /: /===/mar/txt-diff /hoon/
::
!:
=, ford
=, format
::
=/ test-pit=vase !>(..zuse)
=/ ford-gate (ford-vane test-pit)
::
|%
++ verify-post-made
|= $: move=move:ford-gate
=duct
=type
date=@da
title=@tas
contents=tape
==
^- tang
::
?> ?=([* %give %made @da %complete %success ^ *] move)
=/ result build-result.result.p.card.move
?> ?=([%success %scry %noun type-a=* @tas *] head.result)
?> ?=([%success ^ *] tail.result)
?> ?=([%success %ride type-title-a=* %post-a] head.tail.result)
?> ?=([%success %ride type-title-b=* %post-b] tail.tail.result)
::
;: welp
%+ expect-eq
!> duct
!> duct.move
::
%+ expect-eq
!> date
!> date.p.card.move
::
%+ expect-eq
!> [%success %scry %noun *^type [title=title contents=contents]]
!> head.result(p.q.cage *^type)
::
%+ expect-eq
!> &
!> (~(nest ut p.q.cage.head.result) | type)
::
%+ expect-eq
!> 'post-a'
vase.head.tail.result
::
%+ expect-eq
!> 'post-b'
vase.tail.tail.result
==
++ scry-with-results
|= results=(map [=term =beam] cage)
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-with-results+[term=term beam=beam]
::
[~ ~ (~(got by results) [term beam])]
:: +scry-with-results-and-failures
::
++ scry-with-results-and-failures
|= results=(map [=term =beam] (unit cage))
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-with-results+[term=term beam=beam]
::
[~ (~(got by results) [term beam])]
:: +scry-succeed: produces a scry function with a known request and answer
::
++ scry-succeed
|= [date=@da result=cage] ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-succeed+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
[~ ~ result]
:: +scry-fail: produces a scry function with a known request and failed answer
::
++ scry-fail
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-fail+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
[~ ~]
:: +scry-block: produces a scry function with known request and blocked answer
::
++ scry-block
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-block+[beam+beam term+term]
?> =(term %cx)
?> =(beam [[~nul %desk %da date] /bar/foo])
::
~
:: +scry-blocks: block on a file at multiple dates; does not include %reef
::
++ scry-blocks
|= dates=(set @da) ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
~| scry-block+[beam+beam term+term]
?> =(term %cx)
?> ?=([%da @da] r.beam)
?> (~(has in dates) p.r.beam)
::
~
:: +scry-is-forbidden: makes sure ford does not attempt to scry
::
++ scry-is-forbidden ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=/ date=@da ?>(?=(%da -.r.beam) p.r.beam)
::
?^ reef=((scry-reef date) +<.$)
reef
::
~| scry-is-forbidden+[beam+beam term+term]
!!
::
++ scry-reef
|= date=@da ^- sley
|= [* (unit (set monk)) =term =beam]
^- (unit (unit cage))
::
=- ?~ res=(~(get by -) [term beam])
~
`res
::
(with-reef date ~)
::
++ with-reef
|= [date=@da scry-results=(map [term beam] cage)]
^+ scry-results
%- ~(gas by scry-results)
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
[%hoon !>(hoon-scry)]
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
[%hoon !>(arvo-scry)]
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
[%hoon !>(zuse-scry)]
::
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
[%cass !>([ud=1 da=date])]
==
::
++ with-reef-unit
|= [date=@da scry-results=(map [term beam] (unit cage))]
^+ scry-results
%- ~(gas by scry-results)
:~ :- [%cx [[~nul %home %da date] /hoon/hoon/sys]]
`[%noun !>(~)]
:- [%cx [[~nul %home %da date] /hoon/arvo/sys]]
`[%noun !>(~)]
:- [%cx [[~nul %home %da date] /hoon/zuse/sys]]
`[%noun !>(~)]
::
:- [%cw [[~nul %home %da date] /hoon/hoon/sys]]
`[%cass !>([ud=1 da=date])]
==
::
++ ford-call
|= $: ford-gate=_ford-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
expected-moves=(list move:ford-gate)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- call:ford [duct ~ type wrapped-task]:call-args
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output ford-gate]
::
++ ford-take
|= $: ford-gate=_ford-gate
now=@da
scry=sley
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
expected-moves=(list move:ford-gate)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- take:ford [wire duct ~ wrapped-sign]:take-args
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output ford-gate]
:: +ford-call-with-comparator
::
:: Sometimes we can't just do simple comparisons between the moves statements
:: and must instead specify a gate that performs the comparisons.
::
++ ford-call-with-comparator
|= $: ford-gate=_ford-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:ford-gate)]
move-comparator=$-((list move:ford-gate) tang)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- call:ford [duct ~ type wrapped-task]:call-args
::
=/ output=tang (move-comparator moves)
::
[output ford-gate]
:: +ford-take-with-comparator
::
++ ford-take-with-comparator
|= $: ford-gate=_ford-gate
now=@da
scry=sley
take-args=[=wire =duct wrapped-sign=(hypo sign:ford-gate)]
move-comparator=$-((list move:ford-gate) tang)
==
^- [tang _ford-gate]
::
=/ ford (ford-gate our=~nul now=now eny=`@`0xdead.beef scry=scry)
::
=^ moves ford-gate
%- take:ford [wire duct ~ wrapped-sign]:take-args
::
=/ output=tang (move-comparator moves)
::
[output ford-gate]
:: +expect-cage: assert that the actual cage has the right mark and vase
::
++ expect-cage
|= [mark=term expected=vase actual=cage]
%+ weld
%+ expect-eq
!> mark
!> p.actual
::
(expect-eq expected q.actual)
:: +expect-ford-empty: assert that ford's state is one empty ship
::
:: At the end of every test, we want to assert that we have cleaned up all
:: state.
::
++ expect-ford-empty
|= [ford-gate=_ford-gate ship=@p]
^- tang
::
=^ results1 ford-gate
%- ford-call :*
ford-gate
now=~1234.5.6
scry=scry-is-forbidden
call-args=[duct=~[/empty] type=~ [%keep 0 0]]
expected-moves=~
==
::
=/ ford *ford-gate
=/ state state.ax.+>+<.ford
::
=/ default-state *ford-state:ford
::
=. max-size.compiler-cache.state max-size.compiler-cache.default-state
=. max-size.queue.build-cache.state max-size.queue.build-cache.default-state
=. next-anchor-id.build-cache.state 0
::
%+ welp results1
::
?: =(default-state state)
~
::
=/ build-state=(list tank)
%- zing
%+ turn ~(tap by builds.state)
|= [build=build:ford build-status=build-status:ford]
:~ [%leaf (build-to-tape:ford build)]
[%leaf "requesters: {<requesters.build-status>}"]
[%leaf "clients: {<~(tap in ~(key by clients.build-status))>}"]
==
::
=/ braces [[' ' ' ' ~] ['{' ~] ['}' ~]]
::
:~ [%leaf "failed to cleanup"]
[%leaf "builds.state:"]
[%rose braces build-state]
==
--

39
pkg/arvo/lib/test/runner.hoon
View File

@ -10,6 +10,45 @@
+$ test-func (trap tang)
--
|%
++ run-test
:: executes an individual test.
|= [pax=path test=test-func]
^- [ok=? =tang]
=+ name=(spud pax)
=+ run=(mule test)
?- -.run
%| :- %| :: the stack is already flopped for output?
;: weld
p.run
`tang`[[%leaf (weld "CRASHED " name)] ~]
==
%& ?: =(~ p.run)
&+[[%leaf (weld "OK " name)] ~]
:: Create a welded list of all failures indented.
:- %|
%- flop
;: weld
`tang`[[%leaf (weld "FAILED " name)] ~]
::TODO indent
:: %+ turn p:run
:: |= {i/tape}
:: ^- tank
:: [%leaf (weld " " i)]
p.run
==
==
:: +filter-tests-by-prefix
::
++ filter-tests-by-prefix
|= [prefix=path tests=(list test)]
^+ tests
::
=/ prefix-length=@ud (lent prefix)
::
%+ skim tests
::
|= [=path *]
=(prefix (scag prefix-length path))
:: +resolve-test-paths: add test names to file paths to form full identifiers
::
++ resolve-test-paths

5
pkg/arvo/mar/acme/order.hoon
View File

@ -2,6 +2,11 @@
:::: /mar/acme/order/hoon
::
|_ a=(set (list @t))
++ grad %noun
++ grow
|%
++ noun a
--
++ grab
|%
++ noun (set (list @t))

5
pkg/arvo/mar/azimuth/update.hoon
View File

@ -1,6 +1,11 @@
::
|_ upd=update:azimuth
::
++ grad %noun
++ grow
|%
++ noun upd
--
++ grab :: convert from
|%
++ noun update:azimuth :: from %noun

5
pkg/arvo/mar/chat/action.hoon
View File

@ -1,5 +1,10 @@
/+ *chat-store
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action

5
pkg/arvo/mar/chat/hook-action.hoon
View File

@ -1,5 +1,10 @@
/+ *chat-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action

2
pkg/arvo/mar/chat/hook-update.hoon
View File

@ -1,7 +1,9 @@
/+ *chat-hook
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs upd)
--
::

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