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

Merge branch 'newunix'

Browse Source 
Conflicts:
	urb/zod/base/ape/dojo.hoon
	urb/zod/base/ape/talk.hoon
This commit is contained in:
Philip C Monk 2015-06-19 17:03:42 -04:00
commit 7cf5d49b6b
239 changed files with 7372 additions and 3898 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

121
base/ape/acto/core.hook
View File

@ -1,121 +0,0 @@
:: :::::::::::::::
:::: /hook/core/acto/ape :: :: :: build
:: :::::::::::::::
/- *sole :: structures
/+ sole :: libraries
:: :::::::::::::::
:::: :: :: :: logic
!: :::::::::::::::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: per game
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :::::::::::::::
:::: :: :: :: agent
:: :::::::::::::::
=> |% :: arvo structures
++ axle ,[%0 eye=face gam=game] :: agent state
++ card ,[%diff lime] :: update
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime ,[%sole-effect sole-effect] :: :sole update
++ move (pair bone card) :: cause and action
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
-- ::
|_ [hid=hide moz=(list move) axle] :: per server
++ et ::
|_ [from say=sole-share] :: per console client
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) come)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) come) ::
?~ dur abet:beep ::
(kick:line(p.eye ~) +.dur) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %acto :: update prompt
": {~[(icon who.gam)]} to move (row/col): " ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: update all
=+ pals ::
|- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
:: :::::::::::::::
:::: :: :: :: hooks
:: :::::::::::::::
++ peer-sole :: console subscribe
|= [from *] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ prep |= [from old=(unit ,[(list move) axle])] :: initialize
=< abet ?~ old +> =< (park %2 ~) ::
+>(+<+ u.old) ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
--

205
base/ape/bit.hoon Normal file
View File

@ -0,0 +1,205 @@
::
::
::::
::
/? 314
/- *talk, *bit-api
/+ talk, sole, http, mean
!:
:::: sivtyv-barnel
:: be sure to have oauth2-code markk
|%
++ axle
$: cred=(unit ,[app-secret=@t client-id=@t])
oauth-code=(unit ,@t)
auth=(unit ,[access=@t refresh=@t])
contacts=(map ,@t ,@t)
outgoing=(map ship ,@t) incoming=(map ,@t ship)
==
++ move ,[bone note]
++ hapt ,[ship path]
++ note
$% [%send wire [ship term] %poke mesa]
[%them wire (unit hiss)]
[%hiss wire mark bit-any]
==
++ gift
$% [%nice ~]
[%mean ares]
==
++ sign
$% [%thou p=httr]
[%unto %coup p=(unit tang)]
==
++ mesa
$% [%bit-addr-request ~]
[%bit-addr-made @t]
[%talk-command command]
==
--
::
!:
|_ [hid=bowl vat=axle]
:: ++ prep ~&(%bit-prep-wipe ,_`.)
++ return [*(list move) .]
++ redirect-uri [hostname `/~~/home/pub/bit/fab ~]
++ hostname ^- hart
?+ (clan our.hid) !!
%czar [| ?+(our.hid `8.443 %~fyr `8.444) `/localhost]
%duke [| `8.444 `/org/urbit/(crip +:<our.hid>)]
==
++ auth-url
%+ weld "https://sandbox.coinbase.com/oauth/authorize"
%- tail:earn :~
'response_type'^%code
'client_id'^client-id:(need cred.vat)
'redirect_uri'^(crip (earn redirect-uri))
'scope'^'user balance buy sell send transactions addresses'
'meta[send_limit_amount]'^'1'
'meta[send_limit_curency]'^'BTC'
'meta[send_limit_period]'^'day'
==
++ old-api
|= [pour-path=wire end-point=path req=$|(%get [%post p=json])]
^- move
%^ httpreq ost.hid pour-path
[/com/coinbase/api v1/end-point req ~ ['access_token' access:(need auth.vat)]~]
::
++ api-call
|= [res=mark req=bit-api-call] ^+ return
~| %missing-access-token
[[ost.hid %hiss / res bit-api-call/[access:(need auth.vat) req]]~ +>.$]
::
++ print |=(msg=tape [[(publish [%lin & (crip msg)]~)]~ +>.$])
++ callback-uri [hostname [`%json /~/to/[dap.hid]/json] ~[anon/'' wire/'/']]
++ poke-auth
|= arg=[secr=cord id=cord]
=. cred.vat `arg
=+ prl=`purl`(need (epur (crip auth-url)))
:_ +>.$
:- %- publish
:~ [%lin & 'secret and client id saved successfully']
[%lin & 'please click on the url below to continue authentication']
[%url prl ~]
==
~
::
++ sigh-tang |=([* err=tang] (mean err))
++ send-friend :: inter-app interface
|= [way=wire his=ship mez=$%([%bit-addr-request ~] [%bit-addr-made @t])]
^- move
[ost.hid %send way [his dap.hid] %poke mez]
::
++ poke-bit-send |=(req=bit-send (api-call %bit-transaction send/req))
++ sigh-bit-transaction
|=([* trid=@t] (print "transaction success {(trip trid)}"))
::
++ poke-bit-ship-send :: send to ship
|= [to=ship amount=@t]
=. outgoing.vat (~(put by outgoing.vat) to amount)
:_ +>.$
:_ ~
(send-friend /sent to %bit-addr-request ~)
++ poke-bit-addr-request :: give your address to receive bit
|= ~ :: gen new address with callback
:_ +>.$
:_ ~
%+ old-api /addr-request/(scot %p src.hid)
:+ /addresses %post
%+ joba %address
%- jobe :~
label/(jape "address for {<src.hid>}")
'callback_url'^(jape (earn callback-uri))
==
::
++ pour-addr-request :: send new address to sender
|= [pax=path rez=json]
=+ adr=(need ((ot address/so ~):jo rez))
=+ his=(slav %p +<.pax)
~! incoming.vat
=. incoming.vat
(~(put by incoming.vat) adr his)
:_ +>.$
:_ ~
(send-friend [%message ~] his %bit-addr-made adr)
::
++ poke-bit-addr-made :: receive address for sending
|= addr=@t
=+ amount=(~(got by outgoing.vat) src.hid) :: get amount to send
(api-call %bit-transaction txt-send/[addr amount])
::
++ poke-oauth2-code
|= code=cord
=. oauth-code.vat
[~ code]
?< ?=(~ cred.vat)
=+ req=[code [client-id app-secret]:u.cred.vat redirect-uri]
[[ost.hid %hiss / %oauth-tokens bit-get-token/req]~ +>.$]
::
++ sigh-oauth-tokens
|= [wire toke=[access=@t refresh=@t]]
=.(auth.vat `toke (print "authenticated."))
::
++ poke-buy
|=(arg=[amount=@t currency=@t] ?<(=(amount.arg ~) (api-call %json %buy arg)))
++ poke-sell
|=(arg=[amount=@t currency=@t] ?<(=(amount.arg ~) (api-call %json %sell arg)))
++ sigh-json |=([* a=json] ~&(a return))
++ poke-list |=(~ (api-call %bit-accounts %list ~))
++ sigh-bit-accounts |=([* acc=bit-accounts] ~&(accounts=acc return))
++ poke-send-raw
|= arg=[to=@t amone=(unit ,@t) cur=(unit ,@t) amtwo=(unit ,@t) nt=(unit ,@t)]
=+ adr=?~((~(get by contacts.vat) to.arg) to ~&('contact-exists' (~(get by contacts.vat) to.arg)))
=+ ^= info
?~ cur.arg
[to/s/to.arg amount/s/(need amone.arg) ~]
?~ nt.arg
[to/s/to.arg 'amount_currency_iso'^s/(need cur.arg) 'amount_string'^s/(need amtwo.arg) ~]
[to/s/to.arg amount/s/(need amtwo.arg) 'amount_string'^s/(need amtwo.arg) ~]
=+ ^= pst
(jobe transaction/(jobe info) ~)
[[(old-api /send /transactions/'send_money' %post pst) ~] +>.$]
::
++ poke-json
|= arg=json
~& arg
=+ [adr amo]=(need %.(arg (ot address/so amount/no ~):jo))
=+ frm=(~(get by incoming.vat) adr)
(print "just received {(trip amo)} BTC from {<frm>}")
::(old-api /get-id /transactions/[transaction-id] %get)
++ pour-get-id :: display transaction info
|= [pax=path rez=json]
:_ +>.$
:_ ~
!!
::
++ thou
|= [way=wire res=httr]
?+ -.way !!
%message `+>.$
?(%addr-request %get-id)
~| 'must receive a 200'
~| res
?> =(200 p.res)
%- ?-(-.way %addr-request pour-addr-request, %get-id pour-get-id)
[way (rash q:(need r.res) apex:poja)]
==
::
++ publish
|= act=(list speech)
^- move
=+ ^= thotz
%+ turn act
|= sp=speech ^- thought
=+ ^= tail
:- ^- audience
:+ :- `partner`[%& our.hid ?+((clan our.hid) !! %czar %court, %duke %porch)]
^- (pair envelope delivery)
[`envelope`[& ~] %pending]
~
~
`statement`[now.hid ~ sp]
:- `@`(sham eny.hid tail)
tail
[ost.hid %send /auth [our.hid %talk] %poke [%talk-command %publish thotz]]
--

273
base/ape/bit/core.hook
View File

@ -1,273 +0,0 @@
::
::
::::
::
/? 314
/- *talk
/+ talk, sole, http
!:
:::: sivtyv-barnel
:: be sure to have oauth2-code markk
|%
++ axle cred
++ cred
$: client-id=(unit ,@t) app-secret=(unit ,@t)
oauth-code=(unit ,@t) auth-token=(unit ,@t)
refr-token=(unit ,@t) contacts=(map ,@t ,@t)
outgoing=(map ship ,@t) incoming=(map ,@t ship)
==
++ move ,[bone note]
++ hapt ,[ship path]
++ note
$% [%send wire [ship term] %poke mesa]
[%them wire (unit hiss)]
==
++ gift
$% [%nice ~]
[%mean ares]
==
++ sign
$% [%thou p=httr]
[%unto %coup p=(unit tang)]
==
++ mesa
$% [%bit-addr-request ~]
[%bit-addr-made @t]
[%talk-command command]
==
--
::
!:
|_ [hid=hide vat=axle]
::++ prep ,_`.
++ redirect-uri (crip (weld hostname "/~~/home/pub/bit/fab"))
++ hostname
?+ (clan our.hid) !!
%czar "http://localhost:{?+(our.hid !! %~zod "8443", %~fyr "8444")}"
%duke "http://{+:<our.hid>}.urbit.org"
==
++ auth-url
%+ weld "https://www.coinbase.com/oauth/authorize"
%- tail:earn :~
'response_type'^%code
'client_id'^(need client-id.vat)
'redirect_uri'^redirect-uri
'scope'^'user balance buy sell send transactions addresses'
'meta[send_limit_amount]'^'1'
'meta[send_limit_curency]'^'BTC'
'meta[send_limit_period]'^'day'
==
++ api-call
|= [ost=bone pour-path=wire end-point=path req=$|(%get [%post p=json])]
^- move
%^ httpreq ost pour-path
[/com/coinbase/api v1/end-point req ~ ['access_token' (need auth-token.vat)]~]
::
++ callback-uri (weld hostname "/~/to/{(trip app.hid)}/json.json?anon&wire=/")
++ poke-auth
|= [[ost=bone you=ship] arg=[secr=cord id=cord]]
=: app-secret.vat [~ secr.arg]
client-id.vat [~ id.arg]
==
=+ prl=`purl`(need (epur (crip auth-url)))
:_ +>.$
:- %^ publish ost you
:~ [%lin & 'secret and client id saved successfully']
[%lin & 'please click on the url below to continue authentication']
[%url prl]
==
~
::
++ send-friend :: inter-app interface
|= [ost=bone way=wire his=ship mez=$%([%bit-addr-request ~] [%bit-addr-made @t])]
^- move
[ost %send way [his app.hid] %poke mez]
::
++ poke-bit-send :: send to address
|= [[ost=bone @] addr=@uc amount=@t]
:_ +>.$
:_ ~
=+ info=[to/s/(rsh 3 2 (scot %uc addr)) amount/s/amount ~]
=+ jon=(joba %transaction (jobe info))
(api-call ost /send /transactions/'send_money' %post jon)
::
++ poke-bit-ship-send :: send to ship
|= [[ost=bone @] to=ship amount=@t]
=. outgoing.vat (~(put by outgoing.vat) to amount)
:_ +>.$
:_ ~
(send-friend ost /sent to %bit-addr-request ~)
++ poke-bit-addr-request :: give your address to receive bit
|= [[ost=bone his=ship] req=~] :: gen new address with callback
:_ +>.$
:_ ~
%^ api-call ost /addr-request/(scot %p his)
:+ /addresses %post
%+ joba %address
%- jobe :~
label/(jape "address for {<his>}")
'callback_url'^(jape callback-uri)
==
::
++ pour-addr-request :: send new address to sender
|= [ost=bone pax=path rez=json]
=+ adr=(need ((ot address/so ~):jo rez))
=+ his=(slav %p +<.pax)
~! incoming.vat
=. incoming.vat
(~(put by incoming.vat) adr his)
:_ +>.$
:_ ~
(send-friend ost [%message ~] his %bit-addr-made adr)
::
++ poke-bit-addr-made :: receive address for sending
|= [[ost=bone his=ship] addr=@t]
:_ +>.$
:_ ~
=+ amount=(~(got by outgoing.vat) his) :: get amount to send
=+ info=[to/s/addr amount/s/amount ~]
=+ jon=(joba %transaction (jobe info))
(api-call ost /send /transactions/'send_money' %post jon)
::
++ poke-oauth2-code
|= [[ost=bone you=ship] code=cord]
=. oauth-code.vat
[~ code]
?< |(?=(~ client-id.vat) ?=(~ oauth-code.vat))
=+ ^= queries
:~ ['grant_type' 'authorization_code']
['code' (need oauth-code.vat)]
['redirect_uri' redirect-uri]
['client_id' (need client-id.vat)]
['client_secret' (need app-secret.vat)]
==
:_ +>.$
:- (httpreq ost /auth-token /com/coinbase /oauth/token [%post ~] ~ queries)
~
++ poke-buy
|= [[ost=bone you=ship] arg=[amount=@t currency=@t]]
?< =(~ amount.arg)
=+ query=['access_token' (need auth-token.vat)]~
=+ ^= pst
?: =(~ currency.arg)
(jobe qty/s/amount.arg ~)
(jobe qty/s/amount.arg currency/s/currency.arg ~)
:_ +>.$
:- (httpreq ost /buy /com/coinbase/api /v1/buys [%post pst] ~ query)
~
::
++ poke-list
|= [[ost=bone you=ship] arg=~]
=+ query=['access_token' (need auth-token.vat)]~
:_ +>.$
:- (httpreq ost /list /com/coinbase/api /v1/accounts %get ~ query)
~
::
++ poke-sell
|= [[ost=bone you=ship] arg=[amount=@t currency=@t]]
?< =(amount.arg ~)
=+ query=['access_token' (need auth-token.vat)]~
=+ ^= pst
?: =(~ currency.arg)
(jobe qty/s/amount.arg currency/s/currency.arg ~)
(jobe qty/s/amount.arg ~)
:_ +>.$
:+ ~
(httpreq ost /buy /com/coinbase/api /v1/sells [%post pst] ~ query)
~
::
++ poke-send-raw
|= $: [ost=bone you=ship]
arg=[to=@t amone=(unit ,@t) cur=(unit ,@t) amtwo=(unit ,@t) nt=(unit ,@t)]
==
=+ adr=?~((~(get by contacts.vat) to.arg) to ~&('contact-exists' (~(get by contacts.vat) to.arg)))
=+ query=['access_token' (need auth-token.vat)]~
=+ ^= info
?~ cur.arg
[to/s/to.arg amount/s/(need amone.arg) ~]
?~ nt.arg
[to/s/to.arg 'amount_currency_iso'^s/(need cur.arg) 'amount_string'^s/(need amtwo.arg) ~]
[to/s/to.arg amount/s/(need amtwo.arg) 'amount_string'^s/(need amtwo.arg) ~]
=+ ^= pst
(jobe transaction/(jobe info) ~)
:_ +>.$
:- (httpreq ost /send /com/coinbase/api /v1/transactions/'send_money' [%post pst] ~ query)
~
::
++ poke-json
|= [[ost=bone you=ship] arg=json]
~& arg
:_ +>.$
=+ [adr amo]=(need %.(arg (ot address/so amount/no ~):jo))
=+ frm=(~(get by incoming.vat) adr)
:_ ~
~! frm
(publish ost our.hid [%lin & (crip "just received {(trip amo)} BTC from {<frm>}")]~)
::(api-call ost /get-id /transactions/[transaction-id] %get)
++ pour-get-id :: display transaction info
|= [ost=bone pax=path rez=json]
:_ +>.$
:_ ~
!!
::
++ thou
|= [[ost=bone @ way=wire] res=httr]
?+ -.way !!
%auth-token
~| 'must receive a 200'^oauth-code.vat
~| res
?> =(200 p.res)
=+ resp=(rash q:(need r.res) apex:poja)
=+ parsed=(need ((ot 'refresh_token'^so 'access_token'^so ~):jo resp))
~& parsed
=: auth-token.vat [~ +.parsed]
refr-token.vat [~ -.parsed]
==
:_ +>.$
:_ ~
(publish ost our.hid [%lin & 'authenticated.']~)
%message `+>.$
?(%addr-request %get-id)
~| 'must receive a 200'
~| res
?> =(200 p.res)
%- ?-(-.way %addr-request pour-addr-request, %get-id pour-get-id)
[ost way (rash q:(need r.res) apex:poja)]
%auth
:_ +>.$
~
?(%get-id %send %buy %list %sell)
~& [`@tas`-.way res]
:_ +>.$
~
%sent
~| 'must receive a 200'
~| res
?> =(200 p.res)
=+ resp=(rash q:(need r.res) apex:poja)
=+ suc=((ot success/so ~):jo resp)
:_ +>.$
:_ ~
?~ suc
(publish ost our.hid [%lin & (crip "something went wrong")]~)
(publish ost our.hid [%lin & (crip "success!")]~)
==
::
++ publish
|= [ost=bone you=ship act=(list speech)]
^- move
=+ ^= thotz
%+ turn act
|= sp=speech ^- thought
=+ ^= tail
:- ^- audience
:+ :- `partner`[%& our.hid ?+((clan our.hid) !! %czar %court, %duke %porch)]
^- (pair envelope delivery)
[`envelope`[& ~] %pending]
~
~
`statement`[lat.hid ~ sp]
:- `@`(sham eny.hid tail)
tail
[ost %send /auth [our.hid %talk] %poke [%talk-command %publish thotz]]
--

650
base/ape/cloud.hoon Normal file
View File

@ -0,0 +1,650 @@
:: digital ocean fleet management
::
::::
::
/? 314
/- *talk
/+ talk, sole, http
::
::
:::: sivtyv-barnel
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: data structures ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!:
|%
++ instance
$: plat=?(%do %gce) name=@t id=@t status=@t created=@da snapshot=name=@t ::disk=@u region=@t
::ip=(list ,@if)
==
++ image
$: plat=?(%do %gce) name=@t id=@t
==
++ create-req-do
$:
name=@t ::region=@t
size=@t image=@t ssh=(list cord)
backups=(unit ,?) ipv6=(unit ,?)
private-networking=(unit ,?) user-data=(unit ,@t)
==
++ create-req-gce ,[project=@t zone=@t name=@t machine-type=@t]
++ axle
$: auth=[do=keys gce=keys] toke=[do=tokens gce=tokens]
insts=(map ,@t instance) images=(map [,[@t @t] image])
==
++ keys ,[authc=(unit ,@t) client-secret=(unit ,@t)]
++ tokens ,[access=@t refresh=@t]
++ move ,[bone card]
++ card
$% [%diff %json json]
[%wait wire @da]
[%send wire [ship term] %poke %talk-command command]
[%them wire (unit hiss)]
==
++ droplet-action
$% [%start ~]
[%stop ~]
[%reboot ~]
[%delete ~]
[%snapshot p=@t]
==
++ cloud-command
$% [%action id=@t name=@t act=droplet-action]
[%create-do p=json]
[%create-gce p=json]
==
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: miscellaneous functions ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
!:
|%
++ auth-queries
|= code=cord
:~ 'grant_type'^'authorization_code'
'code'^code
:- 'client_id'
'd8f46b95af38c1ab3d78ad34c2157a6959c23eb0eb5d8e393f650f08e6a75c6f'
'redirect_uri'^'http://localhost:8443/home/pub/cloud/fab'
==
::
++ parse-iso8601
=< (cook to-time (parsf ;"{parse-day}T{parse-seconds}{parse-zone}"))
|%
++ to-time
|= [[y=@u m=@u d=@u] t=[h=@u m=@u s=@u ms=@u] [syn=? zh=@u zm=@u]]
^- @da
%- year
^- date
=: h.t ?:(syn (sub h.t zh) (add h.t zh))
m.t ?:(syn (sub m.t zm) (add m.t zm))
==
[[& y] m d h.t m.t s.t (div (mul ms.t 0x1.0000) 1.000) ~]
++ parse-day (parsf ;"{dem}\-{dem}\-{dem}")
++ parse-seconds (parsf ;"{dem}:{dem}:{dem}{(optional ;~(pfix dot dem))}")
++ optional |*(fel=_rule ;~(pose fel (easy 0)))
++ parse-zone
;~ pose
(cold [& 0 0] (jest 'Z'))
(parsf ;"{parse-zone-sign}{dem}:{dem}")
==
++ parse-zone-sign ;~(plug ;~(pose (cold & lus) (cold | hep)))
--
++ parse-cloud-command
=+ jo
%- of :~
[%create-gce some]
[%create-do some]
::[%create-gce some]
:- %action
(ot id/so name/so act/parse-droplet-action ~)
==
++ parse-droplet-action
=> jo
%- of :~
[%start ul]
[%stop ul]
[%reboot ul]
[%delete ul]
[%snapshot so]
==
++ key-do
(mo [%start 'power_on'] [%stop 'shutdown'] [%reboot 'power_cycle'] ~)
::
++ adapter-do
|= a=cord
(~(got by key-do) a)
::
++ parse-ip-do
=> jo
%- ot
:_ ~ v4/(ar (ot 'ip_address'^(su lip:ag) ~))
::
++ parse-ip-gce
=> jo
%+ cu |=(a=(list (list ,@if)) `(list ,@if)`(zing a))
(ar (ot 'accessConfigs'^(ar (ot 'natIP'^(su lip:ag) ~)) ~))
::
++ tail-url
|= a=cord
-:(flop q.q:(need (epur a)))
::
++ parse-region
=> jo
(ot name/so ~)
::
++ parse-id-text
|= jon=json
?.(?=([?(%n %s) *] jon) ~ (some p.jon))
::
++ create-do-body
|= $: name=@t ::region=@t
size=@t image=@t ssh-keys=(list cord)
backups=(unit ,?) ipv6=(unit ,?) private-networking=(unit ,?) user-data=(unit ,@t)
==
%- jobe
:~ name/s/name ::region/s/region
size/s/size image/s/image ::(jone image)
backups/?~(backups ~ b/u.backups) ipv6/?~(ipv6 ~ b/u.ipv6)
'user_data'^?~(user-data ~ s/u.user-data) 'private_networking'^?~(private-networking ~ b/u.private-networking)
==
::
++ convert-do
|= a=?(%start %stop %reboot %snapshot)
?- a
%start
'power_on'
%stop
'shutdown'
%reboot
'power_cycle'
%snapshot
'snapshot'
==
::
++ instance-to-json
|= a=(list instance)
^- json
%+ joba 'instances'
:- %a
%+ turn a
|= instance
^- json
%- jobe
:~ name/`json`s/name
id/s/id
status/s/status
created/s/(crip (dust (yore created)))
::region/s/region
snapshot/s/snapshot
::disk/`json`(jone disk)
::ip/a/(turn ip |=(a=@if s/(rsh 3 1 (scot %if a))))
==
++ map-to-list
|= a=(map [,[@t @t] image])
^- liz=(list image)
%+ turn (~(tap by a) *(list ,[[@t @t] image]))
|=(a=[[@t @t] image] `image`+.a)
::
++ image-to-json
|= a=(list image)
%+ joba 'images'
:- %a
%+ turn a
|= image
^- json
%- jobe
:~ name/s/name id/s/id ==
--
::::::::::::::::
:: main door ::
::::::::::::::::
!:
|_ [bowl vat=axle]
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: miscellaneous arms that have to be in main door for scope reasons ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
::++ prep ,_`.
::
++ thou
|= [pour-path=path resp=?(httr *)]
^- [(list move) _+>.$]
~& unhandled-pour-path/resp
:_ +>.$ ~
++ httpreq
|= $: pour-path=wire :: must be in main door because of scope
domain=(list cord) end-point=path
req-type=$?(%get %delt [%post json]) headers=math
queries=quay
==
^- move
=+ ^- parsed-url=purl
:+ ^= host-port :: ++hart
:+ security=%.y
port=~
host=[%.y [path=[%com domain]]]
endpoint=[extensions=~ point=end-point] :: ++pork,
q-strings=queries :: ++quay
=+ ^- request=hiss :: cast to hiss
:- parsed-url
?@ req-type
[req-type headers ~]
[%post headers ~ (tact (pojo +.req-type))]
:^ ost %them pour-path
`(unit hiss)`[~ request]
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: manage supscriptions and publish to talk ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ peer
|= pax=path
^- [(list move) _+>.$]
:_ +>.$
=+ lis=(~(tap by insts.vat))
[ost %diff %json (instance-to-json (turn lis |=(a=[@t instance] +.a)))]~
::
++ spam
|= jon=json
%+ turn (~(tap by sup))
|= [sub=bone @ pax=path]
^- move
[sub %diff %json jon]
::
++ publish
|= [act=(list speech)]
^- move
=+ ^= spchz
%+ turn act
|= sp=speech
=+ ^= tail
:- ^- audience
:+ :- `partner`[%& our ?+((clan our) !! %czar %court, %duke %porch)]
^- (pair envelope delivery)
[`envelope`[& ~] %pending]
~
~
`statement`[now ~ sp]
^- thought
:- `@`(sham eny tail)
tail
=+ mez=[%talk-command [%publish `(list thought)`spchz]]
[ost %send /pub [our %talk] %poke mez]
++ thou-pub |=(~ :_(+>.$ ~))
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: authentication ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ poke-cloud-auth
|= [cde=cord typ=cord]
^- [(list move) _+>.$]
?: =(%do typ)
=. authc.do.auth.vat
[~ cde]
:_ +>.$ ~
=. access.gce.toke.vat
cde
:_ +>.$
:_ list-gce
(publish [%lin & 'successfully authenticated to gce']~)
::
++ poke-cloud-secret
|= [secret=cord typ=cord]
^- [(list move) _+>.$]
?+ typ ~|(missing-platform=typ !!)
%do
=. client-secret.do.auth.vat
[~ secret]
:_ +>.$
:_ ~
%+ httpreq /do/auth
:^ ~[%digitalocean %cloud] `path`/v1/oauth/token
[%post ~]
:- ~ `quay`['client_secret'^secret (auth-queries (need authc.do.auth.vat))]
==
::
++ thou-do-auth
|= [~ resp=httr]
^- [(list move) _+>.$]
~| resp
=+ body=(rash q:(need r.resp) apex:poja)
~| recieve-auth/resp(r body)
=+ [ac re]=(need ((ot 'access_token'^so 'refresh_token'^so ~):jo body))
=: access.do.toke.vat ac
refresh.do.toke.vat re
==
:_ +>.$
:- (publish [%lin & 'successfully authenticated']~)
list-do
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: create digital ocean droplets ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ create-do
|= act=json
=+ ^- deets=create-req-do
%- need
%. act
=> jo
%- ot
:~ name/so size/so image/so :: id key:img object region/so
ssh/(ar so) backups/(mu bo)
'ipv6'^(mu bo) 'priv_networking'^(mu bo) 'user_data'^(mu so)
==
=+ ^- body=json
%- create-do-body :*
name.deets size.deets image.deets ssh.deets backups.deets ::region.deets
ipv6.deets private-networking.deets user-data.deets
==
%- httpreq :*
/create-do
~[%digitalocean %api] /v2/droplets
[%post body]
%^ mo ['Content-Type' 'application/json; charset=utf-8' ~]
['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~]
~
~
==
::
++ thou-create-do |=([path resp=httr] ~&(resp :_(+>.$ ~)))
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: create google instances ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ reserve-ip
|= name=json
=+ nam=(need ((ot name/so ~):jo name))
%- httpreq
:* /reserve-ip/[nam]
~['googleapis' 'www']
/compute/v1/projects/urbcloud/regions/us-central1/addresses
[%post (joba name/s/nam)]
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~]
~
*quay
==
::
++ thou-reserve-ip
|= [pax=path resp=httr]
~& resp
~| r.resp
=+ parsed=(rash q:(need r.resp) apex:poja)
=+ ur=(need ((ot 'targetLink'^so ~):jo parsed))
~& initial-response/parsed
=+ name=-:(flop q.q:(need (epur ur)))
=+(buf=`@da`(add ~s10 now) :_(+>.$ [ost %wait `path`/check-ip-status/[name] buf]~))
::
++ wake-check-ip-status
|= [name=path ~]
~& this-is-the-name/name
=+ nam=?~(name !! -.name)
:_ +>.$
:_ ~
%- httpreq
:* `path`/check-ip-status/[nam]
~['googleapis' 'www']
`path`/compute/v1/projects/urbcloud/regions/us-central1/addresses/[nam]
%get
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~]
~
*quay
==
++ thou-check-ip-status
|= [name=path resp=httr]
~& api-resp/resp
=+ parsed=(rash q:(need r.resp) apex:poja)
!!
::?. =('RESERVED' (need ((ot status/so ~):jo parsed)))
::
++ create-gce
|= jon=json
=+ ^- [name=@t image=@t number=@ud]
(need ((ot name/so 'instance_img'^so number/ni ~):jo jon))
|- ^- (list move)
?~ number ~
:_ $(number (dec number))
=+ nam=(cat 3 name (scot %ud number))
=+ ^- body=json
%- jobe
:~ name/s/nam 'machineType'^s/'zones/us-central1-a/machineTypes/n1-standard-1'
:- %disks :- %a :_ ~
%- jobe
:+ 'initializeParams'^`json`(joba 'sourceImage'^s/image)
boot/b/%.y
~
:- 'networkInterfaces' :- %a :_ ~
(joba 'network' `json`[%s 'global/networks/default'])
==
^- move
%- httpreq
:* `path`/create-gce
`(list cord)`~['googleapis' 'www'] `path`/compute/v1/projects/urbcloud/zones/us-central1-a/'instances'
[%post `json`body]
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~]
~
`quay`[%key access.gce.toke.vat]~
==
::
++ thou-create-gce |=([path resp=httr] ~&(resp :_(+>.$ ~)))
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: perform actions on instances (both kinds) ::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ poke-json :: receive action from client
|= jon=json
^- [(list move) _+>.$]
=+ action=`cloud-command`(need (parse-cloud-command jon))
:_ +>.$
?- -.action
%create-gce [(reserve-ip p.action)]~
%create-do [(create-do p.action)]~
::%create-gce [(create-gce p.action)]
%action [(instance-action [id name act]:action)]~
==
++ instance-action
|= [id=@t name=@t action=droplet-action]
=+ d=(~(got by insts.vat) id)
~| 'can\'t find id'
=+ typ=?~(d !! -.d)
?- typ
%do
=+ ^= meth
?: ?=(%delete -.action)
%delt
[%post (jobe type/s/(convert-do -.action) ?.(?=(%snapshot -.action) ~ [name/s/p.action ~]))]
^- move
=+ ^= req
%- httpreq :*
/do/[-.action]
~[%digitalocean %api]
?:(?=(%delt meth) /v2/droplets/[id] /v2/droplets/[id]/actions)
meth
%^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~
*quay
==
req
::
%gce
=+ ^= head-query
:- %^ mo ['Content-Type' 'application/json' ~]
['Authorization' (cat 3 'Bearer ' access.gce.toke.vat) ~] ~
*quay
?- -.action
?(%start %stop %reboot %'snapshot')
=+ end=/compute/v1/projects/urbcloud/zones/us-central1-a/instances/[name]
%- httpreq
:* /gce-act/[-.action] ~['googleapis' 'www']
(welp end [?:(?=(%reboot -.action) 'reset' -.action) ~])
[%post ~]
head-query
==
::
%delete
=+ end=/compute/v1/projects/urbcloud/zones/us-central1-a/instances/[name]
%- httpreq
:* /gce-act/[-.action] ~['googleapis' 'www']
end
%delt
head-query
==
==
==
++ thou-do-act
|= [pax=path resp=httr]
~& [resp act/pax]
:_ +>.$ ~
::
++ thou-gce-act
|= [pax=path resp=httr]
~& [resp act/pax]
:_ +>.$ ~
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: retrieve google instances and images ::
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ list-gce
^- (list move)
:+ (list-something-gce /zones/['us-central1-a']/instances)
(list-something-gce /global/snapshots)
~
::
++ list-something-gce
|= endpoint=path
=+ ^= lis
:*
/list-gce/[-.endpoint]
~[%googleapis %www] (welp /compute/v1/projects/urbcloud endpoint)
%get ~
^- quay
[%'access_token' access.gce.toke.vat]~
==
~! lis
~! +<:httpreq
(httpreq lis)
::
++ thou-list-gce-zones :: instances
|= [pax=path resp=httr]
^- [(list move) _+>.$]
=+ parsed=(rash q:(need r.resp) apex:poja) :: body httr to json
~| 'no list received or bad json'
=+ items=(need ((ot items/(ar some) ~):jo parsed))
=+ ^- ins=(list ,[@t instance])
~| 'bad-json'^items
%+ turn items
|= in=json
=< [id .]
^- instance
:- %gce
%- need
%. in =+ jo
%- ot
:~ name/so id/so status/so 'creationTimestamp'^(su parse-iso8601) ::zone/so
'machineType'^(cu tail-url so)
:: 'networkInterfaces'^parse-ip-gce
==
=. insts.vat
%- mo
%+ weld ins
%+ skip (~(tap by insts.vat)) :: keep non-gce
|= a=[@t instance] ?=(%gce +<.a)
=+ buf=`@da`(add ~s10 now)
=+ liz=(~(tap by insts.vat))
=+ tail=(turn liz |=(a=[@t instance] +.a))
:_ +>.$ ::
:- [ost %wait /refresh-gce buf]
(spam (instance-to-json tail))
::
++ thou-list-gce-global :: imgs
|= [pax=path resp=httr]
^- [(list move) _+>.$]
=+ parsed=(rash q:(need r.resp) apex:poja)
=+ imgz=(need ((ot items/(ar some) ~):jo parsed))
=. images.vat
%- mo
%+ weld
%+ skip (~(tap by images.vat) *(list ,[[@t @t] image]))
|=(a=[[@t @t] image] ?=(%gce ->.a))
%+ turn imgz
|= a=json
=< [[name %gce] .]
^- image
:- %gce
%- need
%. a =+ jo
%- ot
[name/so id/so ~]
:_ +>.$ [(spam `json`(image-to-json `(list image)`(map-to-list images.vat)))]
::
++ wake-refresh-gce |=([path ~] [list-gce +>.$])
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: list digital ocean droplets and images ::
:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ list-do
:+((list-something-do %droplets) (list-something-do %images) ~)
++ list-something-do
|= som=@tas
=+ ^= lis
:~ /list-do/[som]
~[%digitalocean %api] /v2/[som]
%get
(mo ['Content-Type' 'application/json' ~] ['Authorization' (cat 3 'Bearer ' access.do.toke.vat) ~] ~)
==
(httpreq lis)
::
++ thou-list-do-droplets
|= [pax=path resp=httr]
^- [(list move) _+>.$]
=+ parsed=(rash q:(need r.resp) apex:poja) :: parse httr to json
~| recieve-list/parsed
=+ dar=(need ((ot droplets/(ar some) ~):jo parsed)) :: reparse ar of insts
=+ ^- dropz=(list ,[@t instance])
~| bad-json/-.dar
%+ turn dar
|= drp=json ^- [@t instance]
=- ~! - -
=< [id .]
^- instance
:- %do
%- need
%. drp
=+ jo
%- ot
:~ name/so id/parse-id-text status/so 'created_at'^(su parse-iso8601) ::region/parse-region
image/(ot name/so ~) ::disk/ni networks/parse-ip-do
==
=. insts.vat
%- mo
%+ weld dropz
%+ skip (~(tap by insts.vat) *(list ,[@t instance]))
|=(a=[@t instance] ?=(%do +>.$))
=+ buf=`@da`(add ~s10 now)
:_ +>.$
:- [ost %wait /refresh-do buf]
%- spam
%- instance-to-json
%+ turn (~(tap by insts.vat) *(list ,[@t instance]))
|=(a=[@t instance] +.a)
::
++ thou-list-do-images
|= [pax=path resp=httr]
=+ parsed=(rash q:(need r.resp) apex:poja)
~| crashed-do-images/parsed
=+ imgz=(need ((ot images/(ar (ot [name/so distribution/so id/no ~])) ~):jo parsed))
=+ ^- images=(list ,[[@t @t] image])
%+ turn imgz
|= [name=@t dist=@t id=@t]
=+ nom=(cat 3 name dist)
[[%do nom] `image`[%do nom id]]
=. images.vat
%- mo
%+ weld images
%+ skip (~(tap by images.vat) *(list ,[[@t @t] image]))
|=(a=[[@t @t] image] ?=(%do ->.a))
:_ +>.$ ~[(spam `json`(image-to-json `(list image)`(map-to-list images.vat)))]
::
++ wake-refresh-do |=([path ~] [list-do +>.$])
--

10
base/ape/curl.hoon Normal file
View File

@ -0,0 +1,10 @@
!:
::::
::
|_ [[^ ^ ost=@ ^] ~]
++ poke |*(a=[mark *] :_(+> [ost %hiss / %wain a]~))
::++ poke-purl |=(a=purl :_(+> [ost %hiss / %wain %purl a]~))
++ poke-noun |=(a=tape (poke %purl (scan a auri:epur)))
++ sigh-wain |=([* a=wain] ~&(a `+>))
++ sigh-tang |=([* a=tang] (mean a))
--

156
base/ape/dojo/core.hook → base/ape/dojo.hoon
View File

@ -1,5 +1,5 @@
:: :: ::
:::: /hook/core/dojo/app :: ::::
:::: /hoon/dojo/app :: ::::
:: :: ::
/? 314 :: arvo kelvin
/- *sole :: console structures
@ -32,7 +32,8 @@
q=dojo-build :: general build
== ::
++ dojo-build :: one ford step
$% [%ex p=twig] :: hoon expression
$% [%ec p=mark q=twig] :: caged expression
[%ex p=twig] :: hoon expression
[%di p=dojo-model] :: dialog
[%dv p=path] :: gate from source
[%fi p=dojo-filter q=dojo-source] :: filter
@ -87,76 +88,15 @@
[%deal wire sock term club] ::
== ::
++ move (pair bone card) :: user-level move
++ hapt ,[p=ship q=path] ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::
++ hood :: assembly plan
$: zus=@ud :: zuse kelvin
sur=(list hoot) :: structures
lib=(list hoof) :: libraries
fan=(list horn) :: resources
src=(list hoop) :: program
== ::
++ hoof (pair term (unit (pair case ship))) :: resource reference
++ hoot (pair bean hoof) :: structure gate/core
++ hoop :: source in hood
$% [%& p=twig] :: direct twig
[%| p=beam] :: resource location
== ::
++ horn :: resource tree
$% [%ape p=twig] :: /~ twig by hand
[%arg p=twig] :: /$ argument
[%day p=horn] :: /| list by @dr
[%dub p=term q=horn] :: /= apply face
[%fan p=(list horn)] :: /. list
[%for p=path q=horn] :: /, descend
[%hel p=@ud q=horn] :: /% propagate heel
[%hub p=horn] :: /@ list by @ud
[%man p=(map span horn)] :: /* hetero map
[%nap p=horn] :: /_ homo map
[%now p=horn] :: /& list by @da
[%saw p=twig q=horn] :: /; operate on
[%see p=beam q=horn] :: /: relative to
[%sic p=tile q=horn] :: /^ cast
[%toy p=mark] :: /mark/ static
== ::
++ milk (trel ship desk silk) :: sourced silk
++ silk :: construction layer
$& [p=silk q=silk] :: cons
$% [%bake p=mark q=beam r=path] :: local synthesis
[%boil p=mark q=beam r=path] :: general synthesis
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%file p=beam] :: from clay
[%join p=mark q=silk r=silk] :: merge
[%mash p=mark q=milk r=milk] :: annotate
[%mute p=silk q=(list (pair wing silk))] :: mutant
[%pact p=silk q=silk] :: patch
[%plan p=beam q=spur r=hood] :: structured assembly
[%reef ~] :: kernel reef
[%ride p=twig q=silk] :: silk thru twig
[%tabl p=(list (pair silk silk))] :: list
[%vale p=mark q=ship r=*] :: validate [our his]
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
++ sign ::
$% [%made p=@uvH q=(each gage tang)] ::
$% [%made p=@uvH q=gage] ::
[%unto p=cuft] ::
== ::
-- ::
:: ::
:::: ::
:: ::
|_ $: hid=hide :: system state
|_ $: hid=bowl :: system state
house :: program state
== ::
++ he :: per session
@ -166,8 +106,16 @@
++ dp-command :: ++dojo-command
%+ knee *dojo-command |. ~+
;~ pose
%+ stag %poke
;~ pfix bar
%+ cook
|= [a=path b=dojo-config]
^- dojo-command
[%poke [our.hid %hood] [0 %ge [0 [%cat %hood a]] b]]
;~(plug (most fas sym) dp-config)
==
::
;~ pfix col
%+ stag %poke
%+ cook
|= [a=goal b=(each dojo-source (trel term path dojo-config))]
^- (pair goal dojo-source)
@ -221,13 +169,13 @@
;~ pose
;~(pfix lus (stag %ge dp-model-cat))
;~(pfix wut (stag %di dp-model-dog))
;~(pfix pam (stag %sc dp-model-pig))
;~(pfix buc (stag %va sym))
;~(pfix pam (stag %ec ;~(plug ;~(sfix sym dot) dp-twig)))
(stag %ex dp-twig)
(ifix [sel ser] (stag %tu (most ace dp-source)))
==
::
++ dp-goal :: ++goal
++ dp-goal :: ++goal
%+ cook |=(a=goal a)
;~ pose
;~ plug
@ -240,7 +188,7 @@
++ dp-model-cat ;~(plug dp-server-cat dp-config) :: ++dojo-model
++ dp-model-dog ;~(plug dp-server-dog dp-config) :: ++dojo-model
++ dp-model-pig ;~(plug dp-server-pig dp-config) :: ++dojo-model
++ dp-path `path`/(scot %p our.hid)/home/(scot %da lat.hid)
++ dp-path `path`/(scot %p our.hid)/home/(scot %da now.hid)
++ dp-server-cat (stag 0 (stag %cat dp-device)) :: ++dojo-server
++ dp-server-dog (stag 0 (stag %dog dp-device)) :: ++dojo-server
++ dp-server-pig (stag 0 (stag %pig dp-device)) :: ++dojo-server
@ -256,7 +204,6 @@
==
::
++ dp-config :: ++dojo-config
%+ cook |=(a=dojo-config a)
;~ plug
(star ;~(pfix ace dp-value))
%+ cook
@ -279,7 +226,7 @@
++ dy-amok +>(poy ~) :: terminate
++ dy-beak :: XX rethink
^- beak
[our.hid %home [%da lat.hid]]
[our.hid %home [%da now.hid]]
::
++ dy-ford :: send work to ford
|= [way=wire kas=silk]
@ -338,6 +285,7 @@
|= bul=dojo-build
^+ [bul +>]
?- -.bul
%ec [bul +>.$]
%ex [bul +>.$]
%di =^(mod +>.$ (dy-init-model p.bul) [[%di mod] +>.$])
%dv [bul +>.$]
@ -450,7 +398,8 @@
dy-amok(var (~(put by var) p.mad (~(got by rez) p.q.mad)))
::
%show
(dy-rash %tan (sell q:(~(got by rez) p.p.mad)) ~)
=+ cay=(~(got by rez) p.p.mad)
(dy-rash %tan ?+(p.cay [(sell q.cay)]~ %tang ;;(tang q.q.cay)))
==
::
++ dy-edit :: handle edit
@ -480,7 +429,7 @@
:+ %mute [%done ~ cag]
^- (list (pair wing silk))
:* :- [[~ 12] ~]
(dy-silk-vase !>([now=lat.hid eny=eny.hid bec=he-beak]))
(dy-silk-vase !>([now=now.hid eny=eny.hid bec=he-beak]))
::
:- [[~ 26] ~]
%- dy-silk-vase
@ -501,14 +450,9 @@
^- silk
(dy-silk-config cag cig)
::
++ dy-silk-device :: device to silk
|= way=wire
^- silk
[%boil %gate [he-beak (flop way)] ~]
::
++ dy-twig-head :: dynamic state
^- vase
:(slop !>(`our=@p`our.hid) !>(`tym=@da`lat.hid) !>(`eny=@uvI`eny.hid))
:(slop !>(`our=@p`our.hid) !>(`tym=@da`now.hid) !>(`eny=@uvI`eny.hid))
::
++ dy-made-dial :: dialog product
|= cag=cage
@ -544,8 +488,9 @@
?+ -.q.u.cud !!
%di [/dial (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%ge [/gent (dy-silk-init-modo (dy-cage p.p.p.q.u.cud) q.p.q.u.cud)]
%dv [/hand (dy-silk-device p.q.u.cud)]
%ex [/hand [%ride p.q.u.cud [[%done ~ %$ dy-twig-head] [%reef ~]]]]
%dv [/hand [%core he-beak (flop p.q.u.cud)]]
%ec [/hand [%cast p.q.u.cud (dy-mare q.q.u.cud)]]
%ex [/hand (dy-mare p.q.u.cud)]
%tu :- /hand
:+ %done ~
:- %noun
@ -556,6 +501,11 @@
(slop hed $(p.q.u.cud t.p.q.u.cud))
==
::
++ dy-mare :: build expression
|= gen=twig
^- silk
[%ride gen [[%done ~ %$ dy-twig-head] [%reef ~]]]
::
++ dy-step :: advance project
|= nex=@ud
^+ +>+>
@ -587,7 +537,7 @@
::
++ he-beak :: logical beam
^- beak
[our.hid syd ?^(luc u.luc [%da lat.hid])]
[our.hid syd ?^(luc u.luc [%da now.hid])]
::
++ he-card :: emit gift
|= cad=card
@ -627,13 +577,12 @@
[& %$ "> "]
::
++ he-made :: result from ford
|= [way=wire dep=@uvH reg=(each gage tang)]
|= [way=wire dep=@uvH reg=gage]
^+ +>
?> ?=(^ poy)
=< he-pine
?- -.reg
%& ?> ?=(@ p.p.reg)
%. p.reg
%& %. p.reg
=+ dye=~(. dy u.poy(pux ~))
?+ way !!
[%hand ~] dy-hand:dye
@ -642,12 +591,15 @@
[%edit ~] dy-made-edit:dye
==
%| (he-diff(poy ~) %tan p.reg)
%tabl !!
==
::
++ he-unto :: result from behn
|= cit=cuft
^+ +>
?> ?=(%coup -.cit)
?. ?=(%coup -.cit)
~& [%strange-unto cit]
+>
?~ p.cit
(he-diff %txt ">=")
(he-diff %tan u.p.cit)
@ -716,15 +668,15 @@
--
::
++ peer-sole
|= [from pax=path]
|= [pax=path]
^- (quip move +>)
~? !=(src our.hid) [%peer-dojo-stranger src]
:: ?> =(src our.hid)
?< (~(has by hoc) ost)
~? !=(src.hid our.hid) [%dojo-peer-stranger ost.hid src.hid pax]
:: ?> =(src.hid our.hid)
~? (~(has by hoc) ost.hid) [%dojo-peer-replaced ost.hid pax]
?> =(~ pax)
=< he-abet
%~ he-peer he
:- [ost ~]
:- [ost.hid ~]
^- session
:* *sole-share :: say=sole-share
%home :: syd=desk
@ -735,24 +687,24 @@
==
::
++ poke-sole-action
|= [from act=sole-action]
|= [act=sole-action]
^- (quip move +>)
:: ~& [%dojo-poke ost src act]
:: ~? !=(src our.hid) [%dojo-poke ost src]
he-abet:(~(he-type he [ost ~] (~(got by hoc) ost)) act)
:: ~& [%dojo-poke ost.hid src.hid act]
:: ~? !=(src.hid our.hid) [%dojo-poke ost.hid src.hid]
he-abet:(~(he-type he [ost.hid ~] (~(got by hoc) ost.hid)) act)
::
++ made
|= [then dep=@uvH reg=(each gage tang)]
he-abet:(~(he-made he [[ost ~] (~(got by hoc) ost)]) way dep reg)
|= [way=wire dep=@uvH reg=gage]
he-abet:(~(he-made he [[ost.hid ~] (~(got by hoc) ost.hid)]) way dep reg)
::
++ unto
|= [then cit=cuft]
he-abet:(~(he-unto he [[ost ~] (~(got by hoc) ost)]) cit)
|= [way=wire cit=cuft]
he-abet:(~(he-unto he [[ost.hid ~] (~(got by hoc) ost.hid)]) cit)
::
++ pull
|= [from pax=path]
|= [pax=path]
^- (quip move +>)
=^ moz +>
he-abet:~(he-stop he [[ost ~] (~(got by hoc) ost)])
[moz +>.$(hoc (~(del by hoc) ost))]
he-abet:~(he-stop he [[ost.hid ~] (~(got by hoc) ost.hid)])
[moz +>.$(hoc (~(del by hoc) ost.hid))]
--

108
base/ape/hood.hoon Normal file
View File

@ -0,0 +1,108 @@
:: :: ::
:::: /hoon/hood/ape :: ::
:: :: ::
/? 314 :: zuse version
/+ sole, talk, helm, kiln, drum :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: module boilerplate
++ hood-0 ::
,[%0 lac=(map ,@tas hood-part)] ::
++ hood-good ::
|* hed=hood-head ::
|= paw=hood-part ::
?- hed ::
%drum ?>(?=(%drum -.paw) `drum-part`paw) ::
%helm ?>(?=(%helm -.paw) `helm-part`paw) ::
%kiln ?>(?=(%kiln -.paw) `kiln-part`paw) ::
== ::
++ hood-head ,_-:*hood-part ::
++ hood-make ::
|* [our=@p hed=hood-head] ::
?- hed ::
%drum (drum-port our) ::
%helm *helm-part ::
%kiln *kiln-part ::
== ::
++ hood-part ::
$% [%drum %0 drum-pith] ::
[%helm %0 helm-pith] ::
[%kiln %0 kiln-pith] ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|_ $: hid=bowl :: system state
hood-0 :: server state
== ::
++ 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
|* [moz=(list) rep=hood-part]
[(flop moz) %_(+> lac (~(put by lac) -.rep rep))]
:: :: ::
:::: :: ::
:: :: ::
++ coup-kiln-fancy (wrap take-coup-fancy):from-kiln
++ coup-kiln-spam ::
|= [way=wire saw=(unit tang)]
~? ?=(^ saw) [%kiln-spam-lame u.saw]
[~ +>]
::
++ coup-drum-phat (wrap take-coup-phat):from-drum
++ coup-helm-hi (wrap coup-hi):from-helm
++ diff-sole-effect-drum-phat (wrap diff-sole-effect-phat):from-drum
++ from-lib
|* _[%helm ..$ ,_abet]:(helm-work)
=> .(+< [identity start finish]=+<)
=- [wrap=- *start] :: usage (wrap handle-arm):from-foo
|* handle=_finish
|= _+<.handle
=. +>.handle (start hid (able identity))
(ably (handle +<))
::
++ from-drum (from-lib %drum [..$ ,_se-abet]:(drum-work))
++ from-helm (from-lib %helm [..$ ,_abet]:(helm-work))
++ from-kiln (from-lib %kiln [..$ ,_abet]:(kiln-work))
::
++ poke-dill-belt (wrap poke-dill-belt):from-drum
++ poke-helm-init (wrap poke-init):from-helm
++ poke-helm-verb (wrap poke-verb):from-helm
++ poke-helm-send-hi (wrap poke-send-hi):from-helm
++ poke-helm-hi (wrap poke-hi):from-helm
++ poke-hood-link (wrap poke-link):from-drum
++ poke-hood-mass (wrap poke-mass):from-helm
++ poke-hood-mount (wrap poke-mount):from-kiln
++ poke-hood-unmount (wrap poke-unmount):from-kiln
++ poke-hood-sync (wrap poke-sync):from-kiln
++ poke-hood-unsync (wrap poke-unsync):from-kiln
++ poke-hood-begin (wrap poke-begin):from-helm
++ poke-hood-invite (wrap poke-invite):from-helm
++ poke-hood-merge (wrap poke-merge):from-kiln
++ poke-hood-reload (wrap poke-reload):from-helm
++ poke-hood-reset (wrap poke-reset):from-helm
++ poke-hood-start (wrap poke-start):from-drum
++ poke-hood-reload-desk (wrap poke-reload-desk):from-helm
++ poke-kiln-cp (wrap poke-cp):from-kiln
++ poke-kiln-rm (wrap poke-rm):from-kiln
++ poke-kiln-mv (wrap poke-mv):from-kiln
++ poke-kiln-schedule (wrap poke-schedule):from-kiln
++ poke-will (wrap poke-will):from-helm
++ mere-kiln (wrap take-mere):from-kiln
++ mere-kiln-sync (wrap take-mere-sync):from-kiln
++ made-kiln (wrap take-made):from-kiln
++ init-helm |=([way=wire *] [~ +>])
++ note-helm (wrap take-note):from-helm
++ reap-drum-phat (wrap reap-phat):from-drum
++ onto-drum (wrap take-onto):from-drum
++ peer-drum (wrap peer):from-drum
++ quit-drum-phat (wrap quit-phat):from-drum
++ went-helm (wrap take-went):from-helm
++ writ-kiln-sync (wrap take-writ):from-kiln
--

152
base/ape/hood/core.hook
View File

@ -1,152 +0,0 @@
:: :: ::
:::: /hook/core/hood/ape :: ::
:: :: ::
/? 314 :: zuse version
/+ sole, talk, helm, kiln, drum :: libraries
:: :: ::
:::: :: ::
!: :: ::
=> |% :: module boilerplate
++ hood-0 ::
,[%0 lac=(map ,@tas hood-part)] ::
++ hood-good ::
|* hed=hood-head ::
|= paw=hood-part ::
?- hed ::
%drum ?>(?=(%drum -.paw) `drum-part`paw) ::
%helm ?>(?=(%helm -.paw) `helm-part`paw) ::
%kiln ?>(?=(%kiln -.paw) `kiln-part`paw) ::
== ::
++ hood-head ,_-:*hood-part ::
++ hood-make ::
|* [our=@p hed=hood-head] ::
?- hed ::
%drum (drum-port our) ::
%helm *helm-part ::
%kiln *kiln-part ::
== ::
++ hood-part ::
$% [%drum %0 drum-pith] ::
[%helm %0 helm-pith] ::
[%kiln %0 kiln-pith] ::
== ::
-- ::
:: :: ::
:::: :: ::
:: :: ::
|_ $: hid=hide :: system state
hood-0 :: server state
== ::
++ 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
|* [moz=(list) rep=hood-part]
[(flop moz) %_(+> lac (~(put by lac) -.rep rep))]
:: :: ::
:::: :: ::
:: :: ::
++ coup-kiln-fancy ::
|= [then saw=(unit tang)]
(ably (take-coup-fancy:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ coup-kiln-spam ::
|= [then saw=(unit tang)]
~? ?=(^ saw) [%kiln-spam-lame u.saw]
[~ +>]
::
++ coup-drum ::
|= [then saw=(unit tang)]
(ably (take-coup:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ diff-sole-effect-drum
|= [then sole-effect]
(ably (diff-sole-effect:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ poke-hood-begin ::
|= [from hood-begin]
(ably (poke-begin:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-helm-init ::
|= [from hood-init]
(ably (poke-init:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-mass ::
|= [from ~]
(ably poke-mass:(helm-work [hid +<-] (able %helm)))
::
++ poke-hood-merge ::
|= [from hood-merge]
(ably (poke-merge:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-reload ::
|= [from hood-reload]
(ably (poke-reload:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-reset ::
|= [from ~]
(ably (poke-reset:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-sync ::
|= [from hood-sync]
(ably (poke-sync:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-unix ::
|= [from hood-unix]
(ably (poke-unix:(kiln-work [hid +<-] (able %kiln)) +<+))
::
++ poke-hood-verb ::
|= [from ~]
(ably (poke-verb:(helm-work [hid +<-] (able %helm)) +<+))
::
++ poke-hood-start ::
|= [from drum-start]
(ably (poke-start:(drum-work [hid +<-] (able %drum)) +<+))
::
++ poke-dill-belt
|= [from dill-belt]
(ably (poke-dill-belt:(drum-work [hid +<-] (able %drum)) +<+))
::
++ poke-will ::
|= [from (unit will)]
(ably (poke-will:(helm-work [hid +<-] (able %helm)) +<+))
::
++ mere-kiln ::
|= [then are=(each (set path) (pair term tang))]
(ably (take-mere:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ made-kiln ::
|= [then @uvH (each gage tang)]
(ably (take-made:(kiln-work [hid ost src] (able %kiln)) way +<+))
::
++ init-helm ::
|= [then *]
[~ +>]
::
++ note-helm ::
|= [then (pair ,@tD tank)]
(ably (take-note:(helm-work [hid ost src] (able %helm)) way +<+))
::
++ reap-drum
|= [then saw=(unit tang)]
(ably (reap:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ onto-drum ::
|= [then saw=(each ,[term @tas @da] tang)]
(ably (take-onto:(drum-work [hid ost src] (able %drum)) way +<+))
::
++ peer-drum
|= [from pax=path]
(ably (peer:(drum-work [hid +<-] (able %drum)) +<+))
::
++ quit-drum
|= then
(ably (quit:(drum-work [hid ost src] (able %drum)) way))
::
++ went-helm ::
|= [then her=ship kay=cape]
(ably (take-went:(helm-work [hid ost src] (able %helm)) way +<+))
--

84
base/ape/oct1.hoon Normal file
View File

@ -0,0 +1,84 @@
:: :: ::
:::: /hoon/oct1/ape :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *sole, *oct1 :: structures
/+ sole, oct1 :: libraries
:: :: ::
:::: :::::: interfaces
!: :: ::
=> |% ::
++ axon ,[%0 eye=face gam=game] :: agent state
++ card ,[%diff %sole-effect sole-effect] :: update
++ face (map bone sole-share) :: console state
++ move (pair bone card) :: cause and action
-- ::
:: :: ::
:::: :::::: parsers
:: :: ::
=> |% ::
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
-- ::
:: :: ::
:::: :::::: process core
:: :: ::
|_ $: bowl :: system state
moz=(list move) :: pending actions
axon :: server state, v0
== ::
:: :: ::
:::: :::::: process tools
:: :: ::
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ eels (~(tap by sup)) :: all clients
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- ::
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=. ost p.i.all ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ flap |=(con=bike (echo eels con)) :: update all clients
++ here ~(. go gam) :: game core
:: :: ::
:::: :::::: process logic
:: :: ::
++ fail (fect %bel ~) :: user error
++ fect |=(sole-effect (dish %diff %sole-effect +<)) :: update console
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:kind) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ prom (fect %pro %& %oct1 voy:here) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn .(eye (~(del by eye) ost)) :: console unsubscribe
++ seen .(eye (~(put by eye) ost *sole-share)) :: console subscribe
++ show prom:(fect %mor rend) :: update console
++ tame (flap |=(_. prom:+<)) :: light update
++ wild (flap |=(_. show:+<)) :: full update
++ word |=(tape (flap |=(_+> (fect:+< txt/+>+<)))) ::
:: :: ::
:::: :::::: process UI
:: :: ::
++ work :: console action
|= act=sole-action ::
=+ say=(~(got by eye) ost) ::
|^ ?:(?=(%det -.act) (delt +.act) dive) ::
++ abet ..work(eye (~(put by eye) ost say)) :: resolve
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt come)) :: apply command line
?~(- fail ?~(-> show (kick:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) come)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
-- ::
:: :: ::
:::: :::::: arvo handlers
:: :: ::
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ prep |= (unit (pair (list move) axon)) :: update self
abet:?~(+< +> wild(+<+ +<+)) ::
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ pull-sole |=(* abet:sawn) :: console unsubscribe
--

102
base/ape/oct2.hoon Normal file
View File

@ -0,0 +1,102 @@
:: :: ::
:::: /hoon/oct2/ape :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *sole, *oct2 :: structures
/+ sole, oct2 :: libraries
:: :: ::
:::: :::::: interfaces
!: :: ::
=> |% ::
++ axle ,[eye=face gam=game] :: agent state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
== ::
++ face (map bone sole-share) :: console state
++ lime ,[%sole-effect sole-effect] :: :sole update
++ move (pair bone card) :: cause and action
-- ::
:: :: ::
:::: :::::: past state
:: :: ::
=> |% ::
++ axon $%([%1 axle] [%0 axle-0]) :: all states
++ axle-0 ,[eye=face gam=game-0] :: old axle
++ game-0 ,[who=? box=board boo=board] :: old game
++ wake |= axon :- %1 ?- +<- %1 +<+ :: rough upgrade
%0 [eye [who ~^~ ~ box boo]:gam]:+<+ ::
== -- ::
:: :: ::
:::: :::::: parsers
:: :: ::
=> |% ::
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) come)) :: with wait mode
-- ::
:: :: ::
:::: :::::: process core
:: :: ::
|_ $: bowl ::
moz=(list move) :: pending actions
[%1 axle] :: process state, v1
== ::
:: :: ::
:::: :::::: process tools
:: :: ::
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- :: publish to all
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=> .(ost p.i.all, src q.i.all) ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ flap |=(con=bike (echo (~(tap by sup)) con)) :: update all clients
++ here ~(. go src gam) :: game core
:: :: ::
:::: :::::: server logic
:: :: ::
++ fail (fect %bel ~) :: user error
++ fect |=(sole-effect (dish %diff %sole-effect +<)) :: update console
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
(muy:here (turn (~(tap by sup)) |=(sink q))) ::
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:kind) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ hail |=(? tame(gam (hey:here +<))) :: toggle subscriber
++ prom (fect %pro %& %oct2 voy:here) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn (hail(eye (~(del by eye) ost)) |) :: console unsubscribe
++ seen (hail(eye (~(put by eye) ost *sole-share)) &) :: console subscribe
++ show prom:(fect %mor rend) :: update console
++ tame (flap |=(_. prom:+<)) :: light update
++ wild (flap |=(_. show:+<)) :: full update
++ word |=(tape (flap |=(_+> (fect:+< txt/+>+<)))) ::
:: :: ::
:::: :::::: console UI
:: :: ::
++ work :: console action
|= act=sole-action ::
=+ say=(~(got by eye) ost) ::
|^ ?:(?=(%det -.act) (delt +.act) dive) ::
++ abet ..work(eye (~(put by eye) ost say)) :: resolve
++ cusp (cope !ept:here) :: parsing rule
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt come)) :: apply command line
?~(- fail ?~(-> show (kick:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
-- ::
:: :: ::
:::: :::::: arvo handlers
:: :: ::
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ prep |= (unit (pair (list move) axon)) :: update self
abet:?~(+< +> wild:(heal +<+>)) ::
++ pull-sole |=(* abet:sawn) :: console unsubscribe
--

115
base/ape/oct3.hoon Normal file
View File

@ -0,0 +1,115 @@
:: :: ::
:::: /hoon/oct3/ape :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *sole, *oct3 :: structures
/+ sole, oct3 :: libraries
:: :: ::
:::: :::::: interfaces
!: :: ::
=> |% ::
++ axle ,[eye=face gam=game] :: agent state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
== ::
++ face (map bone sole-share) :: console state
++ lime $% [%sole-effect sole-effect] :: :sole update
[%oct3-update play] :: :oct3 update
== ::
++ move (pair bone card) :: cause and action
-- ::
:: :: ::
:::: :::::: past state
:: :: ::
=> |% ::
++ axon $%([%1 axle] [%0 axle-0]) :: all states
++ axle-0 ,[eye=face gam=game-0] :: old axle
++ game-0 ,[who=? box=board boo=board] :: old game
++ wake |= axon :- %1 ?- +<- %1 +<+ :: coarse upgrade
%0 [eye [who ~^~ ~ box boo]:gam]:+<+ ::
== -- ::
:: :: ::
:::: :::::: parsers
:: :: ::
=> |% ::
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) come)) :: with wait mode
-- ::
:: :: ::
:::: :::::: process core
:: :: ::
|_ $: bowl ::
moz=(list move) :: pending actions
[%1 axle] :: process state, v1
== ::
:: :: ::
:::: :::::: process tools
:: :: ::
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- :: publish to all
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=> .(ost p.i.all, src q.i.all) ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ eels (~(tap by sup)) :: all clients
++ elfs (prey /oct3 +<-) :: network clients
++ elks (prey /sole +<-) :: console clients
++ flap |= [net=bike con=bike] :: update all clients
(echo:(echo elks con) elfs net) ::
++ here ~(. go src gam) :: game core
:: :: ::
:::: :::::: server logic
:: :: ::
++ fail ?:(soul (fect %bel ~) ~|(%invalid-move !!)) :: user error
++ fect |=(sole-effect (dish %diff %sole-effect +<)) :: update console
++ fact |=(play (dish %diff %oct3-update +<)) :: update partner
++ hail |=(? tame(gam (hey:here +<))) :: toggle subscriber
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
(muy:here (turn eels |=(sink q))) ::
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:kind) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ prom (fect %pro %& %oct3 voy:here) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn (hail(eye (~(del by eye) ost)) |) :: console unsubscribe
++ seen (hail(eye (~(put by eye) ost *sole-share)) &) :: console subscribe
++ show prom:(fect %mor rend) :: update console
++ soul =+((~(get by sup) ost) ?=([~ * %sole *] -)) :: is console
++ tame (flap |=(_. (fact:+< &/gam)) |=(_. prom:+<)) :: light update
++ wild (flap |=(_. (fact:+< &/gam)) |=(_. show:+<)) :: full update
++ word |= txt=tape %+ flap :: game message
|=(_+> (fact:+< |/txt)) ::
|=(_+> (fect:+< txt/txt)) ::
:: :: ::
:::: :::::: console UI
:: :: ::
++ work :: console action
|= act=sole-action ::
=+ say=(~(got by eye) ost) ::
|^ ?:(?=(%det -.act) (delt +.act) dive) ::
++ abet ..work(eye (~(put by eye) ost say)) :: resolve
++ cusp (cope !ept:here) :: parsing rule
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt come)) :: apply command line
?~(- fail ?~(-> show (kick:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
-- ::
:: :: ::
:::: :::::: arvo handlers
:: :: ::
++ peer-oct3 |=(* abet:tame:(hail &)) :: urbit subscribe
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ poke-oct3-move |=(point abet:wild:(kick +<)) :: urbit move
++ prep |= (unit (pair (list move) axon)) :: update self
abet:?~(+< +> wild:(heal +<+>)) ::
++ pull-oct3 |=(* abet:(hail |)) :: urbit unsubscribe
++ pull-sole |=(* abet:sawn) :: console unsubscribe
--

138
base/ape/oct4.hoon Normal file
View File

@ -0,0 +1,138 @@
:: :: ::
:::: /hoon/oct4/ape :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *sole, *oct4 :: structures
/+ sole, oct4 :: libraries
:: :: ::
:::: :::::: interfaces
!: :: ::
=> |% ::
++ axle ,[eye=face rem=(unit ship) gam=game] :: agent state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
[%peer wire dock path] :: subscribe
[%poke wire dock pear] :: send move
[%pull wire dock ~] :: unsubscribe
== ::
++ face (map bone sole-share) :: console state
++ lime $% [%sole-effect sole-effect] :: :sole update
[%oct4-update play] :: :oct4 update
== ::
++ move (pair bone card) :: cause and action
++ pear ,[%oct4-move point] :: outgoing move
-- ::
:: :: ::
:::: :::::: past state
:: :: ::
=> |% ::
++ agon (unit ,[(list move) axon]) :: boot argument
++ axon $%([%1 axle] [%0 axle-0]) :: all states
++ axle-0 ,[eye=face gam=game-0] :: old axle
++ game-0 ,[who=? box=board boo=board] :: old game
++ wake |= axon :- %1 ?- +<- %1 +<+ :: coarse upgrade
%0 [eye ~ [who ~^~ ~ box boo]:gam]:+<+ ::
== -- ::
:: :: ::
:::: :::::: parsers
:: :: ::
=> |% ::
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ comb (pick come ;~(pfix sig (punt fed:ag))) :: all command input
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) comb)) :: with wait mode
-- ::
:: :: ::
:::: :::::: process core
:: :: ::
|_ $: bowl
moz=(list move) :: pending actions
[%1 axle] :: process state, v1
== ::
:: :: ::
:::: :::::: process tools
:: :: ::
++ abet [(flop moz) .(moz ~)] :: resolve
++ bike $+(_. _+>) :: self-transformer
++ dish |=(cad=card %_(+> moz [[ost cad] moz])) :: request
++ done (echo eels |=(_. (dish:+< %quit ~))) :: cancel everyone
++ echo |= [all=(list sink) fun=bike] =+ old=+>+<- :: publish to all
|- ^+ +>.^$ ?~ all +>.^$(+<- old) ::
=> .(ost p.i.all, src q.i.all) ::
$(all t.all, +>.^$ (fun +>.^$)) ::
++ eels (~(tap by sup)) :: all clients
++ elfs (prey /oct4 +<-) :: network clients
++ elks (prey /sole +<-) :: console clients
++ emit |=(lime (dish %diff +<)) :: publish
++ flap |= [net=bike con=bike] :: update all clients
(echo:(echo elks con) elfs net) ::
++ here ~(. go src gam) :: game core
:: :: ::
:::: :::::: server logic
:: :: ::
++ fail ?:(soul (fect %bel ~) ~|(%invalid-move !!)) :: user error
++ fect |=(sole-effect (emit %sole-effect +<)) :: update console
++ fact |=(play (emit %oct4-update +<)) :: update partner
++ hail |=(? ?^(rem +> tame(gam (hey:here +<)))) :: toggle subscriber
++ harp |=(game ?:(=(gam +<) +> wild(gam +<))) :: update game
++ heal |= old=axon =. +>+<+> (wake old) :: complete update
=- +>.$(gam -) ?. !=(1 +<-) gam ::
(muy:here (turn eels |=(sink q))) ::
++ hear |=(play ?-(+<- | (word +<+), & (harp +<+))) :: network update
++ kick |= point =^ dud gam ~(m at:here +<) ::
?.(dud fail wild:?~(rem kind (send +>-))) ::
++ kind =+(res:here ?~(- + (word(gam new:here) ->))) :: move result
++ plan |= (unit ship) ?~ +< stop(gam new:here) :: link/unlink
?^(rem fail link(rem +<)) ::
++ plot |= (each point (unit ship)) :: apply command
?-(+<- & (kick +<+), | (plan +<+)) ::
++ like |*(* [/oct4 [+.rem dap] +<]) :: friend message
++ link (dish peer/(like /oct4)) :: subscribe to friend
++ prom (fect %pro %& %oct4 stat) :: update prompt
++ rend (turn `wall`tab:here |=(tape txt/+<)) :: table print
++ sawn (hail(eye (~(del by eye) ost)) |) :: console unsubscribe
++ seen (hail(eye (~(put by eye) ost *sole-share)) &) :: console subscribe
++ send |=(point (dish poke/(like %oct4-move +<))) :: send move
++ show prom:(fect %mor rend) :: update console
++ soul =+((~(get by sup) ost) ?=([~ * %sole *] -)) :: is console
++ stat (weld ?~(rem ~ "@{(scow p/u.rem)}") voy:here) :: prompt line
++ stop ?~(rem done wild:(dish pull/(like ~))) :: unsubscribe
++ tame (flap |=(_. (fact:+< &/gam)) |=(_. prom:+<)) :: light update
++ wild (flap |=(_. (fact:+< &/gam)) |=(_. show:+<)) :: full update
++ with |=(? (word(rem ?:(+< rem ~)) "{<[+< src]>}")) ::
++ word |= txt=tape %+ flap :: game message
|=(_+> (fact:+< |/txt)) ::
|=(_+> (fect:+< txt/txt)) ::
:: :: ::
:::: :::::: console UI
:: :: ::
++ work :: console action
|= act=sole-action ::
=+ say=(~(got by eye) ost) ::
|^ ?:(?=(%det -.act) (delt +.act) dive) ::
++ abet ..work(eye (~(put by eye) ost say)) :: resolve
++ cusp (cope !ept:here) :: parsing rule
++ delt |= cal=sole-change :: edit command line
=^ cul say (~(remit cs say) cal good) ::
?~(cul abet fail:(fect:abet det/u.cul)) ::
++ dive =+ (rust (tufa buf.say) (punt comb)) :: apply command line
?~(- fail ?~(-> show (plot:wipe ->+))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: validate input
++ wipe =^ cal say (~(transmit cs say) set/~) :: clear line
(fect:abet %det cal) ::
-- ::
:: :: ::
:::: :::::: arvo handlers
:: :: ::
++ reap-oct4 |=([* (unit)] abet:(with =(~ +<+))) :: linked to friend
++ coup-oct4 |=([* (unit)] abet:?~(+<+ +> fail)) :: move acknowledge
++ diff-oct4-update |=([* play] abet:(hear +<+)) :: network update
++ peer-oct4 |=(* abet:tame:(hail &)) :: urbit subscribe
++ peer-sole |=(* abet:show:seen) :: console subscribe
++ poke-sole-action |=(sole-action abet:(work +<)) :: console input
++ poke-oct4-move |=(point abet:wild:(kick +<)) :: urbit move
++ prep |=(agon abet:?~(+< +> (heal +<+>))) :: load state
++ pull-oct4 |=(* abet:(hail |)) :: urbit unsubscribe
++ pull-sole |=(* abet:sawn) :: console unsubscribe
++ quit-oct4 |=(* abet:?~(rem +> wild(rem ~))) :: unlinked by friend
--

185
base/ape/octo/core.hook
View File

@ -1,185 +0,0 @@
:: :: ::
:::: /hook/core/acto/ape :: :: dependencies
:: :: ::
/- *sole :: structures
/+ sole :: libraries
:: :: ::
:::: :: :: structures
!: :: ::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: per game
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :: ::
:::: :: :: server
:: :: ::
=> |% :: arvo structures
++ axle ,[%1 eye=face but=tube gam=game] :: agent state
++ axon $?(axle [%0 eye=face gam=game]) :: historical state
++ card $% [%diff lime] :: update
[%quit ~] :: cancel
[%peer wire dock path] :: subscribe
[%pull wire dock ~]
== ::
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime $% [%sole-effect sole-effect] :: :sole update
[%octo-game game] :: :octo update
== ::
++ move (pair bone card) :: cause and action
++ mote (pair ship ,?) :: remote binding
++ tube (unit (pair ,? mote)) :: alive, remote
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
++ comb (pick come ;~(pfix sig (punt comp))) :: all command input
++ comp ;~(plug fed:ag ;~(pfix ace (flag %x %o))) :: login command
++ cope |=(? ?:(+< (stag %| (cold ~ sig)) comb)) :: with wait mode
-- ::
|_ [hid=hide moz=(list move) axle] :: per agent
++ et ::
|_ [from say=sole-share] :: per console client
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ cusp (cope wait) :: parsing rule
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) cusp)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) comb) ::
?~ dur abet:beep ::
=. + line(p.eye ~) ::
?-(+<.dur & (kick +>.dur), | (plan +>.dur)) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %octo :: update prompt
?: wait "(their turn) " ::
": {~[(icon who.gam)]} to move (row/col): " ::
++ plan |= mut=(unit mote) :: peer command
?~ mut ?~(but abet:beep stop:abet) ::
?^(but abet:beep (link:abet u.mut)) ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ wait &(?=(^ but) !=(q.q.u.but who.gam)) :: waiting turn
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ dump |=(mov=move %_(+> moz [mov moz])) :: send move
++ dish |=(cad=card (dump 0 cad)) :: forward move
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ like |=(a=ship |*(* [/octo [a %tictactoe] +<])) :: to friend
++ link |= mot=mote %+ dish(but `[| mot]) %peer :: subscribe to friend
((like p.mot) /octo/net/[?:(q.mot %x %o)]) ::
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: update all
=. +> ?:(=(%2 lev) push +>) ::
=+ pals ::
|- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
++ push =+ pey=(pale hid (prix /octo)) |- ^+ +> :: update friends
?~(pey +> $(pey t.pey, +> (sell p.i.pey))) ::
++ sell |=(ost=bone (dump ost %diff %octo-game gam)) :: update friend
++ stop (dish(but ~) pull/((like +>-.but) ~)) :: cancel subscribe
:: :::::::::::::::
:::: :: :: :: hooks
:: :::::::::::::::
++ diff-octo-game :: friend update
|= [then gam=game] =< abet ::
?. &(?=([~ %& *] but) =(src p.q.u.but)) +> ::
?: =(^gam gam) +> ::
(park(gam gam) %2 ~) ::
++ peer-octo-net :: urbit peer
|= [from pax=path] =< abet ::
=+ who==(%x -.pax) ::
?^ but (park %2 ~) ::
(park:(link src !who) %2 `"net from {<src>}") ::
++ peer-octo-web :: web peer
|= [from pax=path] =< abet ::
~& [%peer-web +<] ::
?^ but (park %2 ~) ::
%+ park(but `[%& src !who.gam]) %2 ::
`"web from {<src>}" ::
++ peer-sole :: console subscribe
|= [from pax=path] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ poke-octo-move ::
|= [from wha=point] =< abet ::
=^ dud gam ~(m ~(at go gam) wha) ::
?> dud =+ mus=~(res go gam) ::
(park(gam ?^(mus *game gam)) %2 mus) ::
++ prep |= [from old=(unit ,[(list move) axon])] :: initialize
=< abet ?~ old +> ::
=< (park %2 ~) ::
?- -.+>.old ::
%1 +>(+<+ u.old) ::
%0 +>(eye.+< eye.+>.old, gam.+< gam.+>.old)::
== ::
++ pull-octo ::
|= [from *] =< abet ::
(park(but ~) %2 `"dropped") ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
++ quit-octo :: unlinked by friend
|=([then ~] abet:(park(but ~) %0 `"removed")) ::
++ reap-octo :: linked to friend
|= [then saw=(unit tang)] =< abet ::
?> ?=([~ %| *] but) ::
?^ saw (park:stop %0 `"fail to {<src>}") ::
(park(p.u.but %&) %0 `"link to {<src>}") ::
--

692
base/ape/sole/core.hook
View File

@ -1,692 +0,0 @@
:: :: ::
:::: /hook/core/sole/app :: ::
:: :: ::
/? 314 :: zuse version
/- *sole :: console structures
/+ sole :: console library
:: :: ::
:::: :: ::
!: :: ::
=> |% :: data structures
++ house :: all state
$: bin=(map bone source) :: input devices
== ::
++ source :: input device
$: edg=_79 :: terminal columns
off=@ud :: window offset
kil=(unit (list ,@c)) :: kill buffer
apt=(list gill) :: application ring
maz=master :: master window
feg=(map gill target) :: live applications
mir=(pair ,@ud (list ,@c)) :: mirrored terminal
== ::
++ master :: master buffer
$: liv=? :: master is live
tar=target :: master target
== ::
++ history :: past input
$: pos=@ud :: input position
num=@ud :: number of entries
lay=(map ,@ud (list ,@c)) :: editing overlay
old=(list (list ,@c)) :: entries proper
== ::
++ search :: reverse-i-search
$: pos=@ud :: search position
str=(list ,@c) :: search string
== ::
++ target :: application target
$: ris=(unit search) :: reverse-i-search
hit=history :: all past input
pom=sole-prompt :: static prompt
inp=sole-command :: input state
== ::
++ ukase :: master command
$% [%add p=(list gill)] :: add agents
[%del p=(list gill)] :: delete agents
== ::
++ suss ,[term @tas @da] :: config report
++ dill :: *forward* to %dill
$% [%crud p=term q=(list tank)] :: fat report
[%text p=tape] :: thin report
[%veer p=@ta q=path r=@t] :: install vane
[%vega p=path] :: reboot by path
[%verb ~] :: verbose mode
== ::
++ pear :: request
$% [%sole-action p=sole-action] ::
== ::
++ lime :: update
$% [%dill-blit dill-blit] ::
== ::
++ card :: general card
$% [%conf wire dock %load ship term] ::
[%diff lime] ::
[%flog wire dill] ::
[%peer wire dock path] ::
[%poke wire dock pear] ::
[%pull wire dock ~] ::
== ::
++ move (pair bone card) :: user-level move
-- ::
|_ $: hid=hide :: system state
house :: program state
== ::
++ sp
|% ++ sp-ukase
%+ knee *ukase |. ~+
;~ pose
(stag %add ;~(pfix lus sp-gills))
(stag %del ;~(pfix hep sp-gills))
==
::
++ sp-gills
;~ pose
(most ;~(plug com ace) sp-gill)
%+ cook
|= a=ship
[[a %dojo] [a %talk] ~]
;~(pfix sig fed:ag)
==
::
++ sp-gill
;~ pose
(stag our.hid sym)
;~ plug
;~(pfix sig fed:ag)
;~(pfix fas sym)
==
==
--
++ se :: per source
|_ $: [moz=(list move) biz=(list dill-blit)]
[src=ship ost=bone]
source
==
++ se-abet :: resolve
:_ %_(+> bin (~(put by bin) ost +<+>))
%+ welp (flop moz)
^- (list move)
?~ biz ~
[ost %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
::
++ se-belt :: handle input
|= bet=dill-belt
^+ +>
?: ?=(%rez -.bet)
+>(edg (dec p.bet))
?: ?=(%yow -.bet)
(se-link p.bet)
=+ gyl=?^(apt i.apt [~zod %$])
=+ taz=~(. ta [& liv.maz gyl] ?:(liv.maz tar.maz (~(got by feg) gyl)))
=< ta-abet
?- -.bet
%aro (ta-aro:taz p.bet)
%bac ta-bac:taz
%cru (ta-cru:taz p.bet q.bet)
%ctl (ta-ctl:taz p.bet)
%del ta-del:taz
%met (ta-met:taz p.bet)
%ret ta-ret:taz
%txt (ta-txt:taz p.bet)
==
::
++ se-drop :: passive drop
|= gyl=gill
^+ +>
?. (~(has by feg) gyl) +>
=. +> (se-blit %out (tuba "[disconnected from {<gyl>}]"))
=< se-prom
%_ +>
feg (~(del by feg) gyl)
apt (skip apt |=(a=gill =(gyl a)))
liv.maz ?~(apt & liv.maz)
==
::
++ se-join :: add connection
|= gyl=gill
^+ +>
=< se-prom
?: (~(has by feg) gyl)
(se-blit %bel ~)
+>(liv.maz |, apt [gyl apt], feg (~(put by feg) gyl *target))
::
++ se-nuke :: active drop
|= gyl=gill
^+ +>
(se-drop:(se-pull(liv.maz |) gyl) gyl)
::
++ se-like :: act in master
|= kus=ukase
?- -.kus
%add
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-link i.p.kus))
::
%del
|- ^+ +>.^$
?~ p.kus +>.^$
$(p.kus t.p.kus, +>.^$ (se-nuke i.p.kus))
==
::
++ se-prom :: set master prompt
^+ .
%_ .
cad.pom.tar.maz
^- tape
%+ welp
(scow %p our.hid)
=+ ^= mux
|- ^- tape
?~ apt ~
=+ ^= mor ^- tape
?~ t.apt ~
[',' ' ' $(apt t.apt)]
%+ welp
^- tape
=+ txt=(trip q.i.apt)
?: =(our.hid p.i.apt)
txt
:(welp "~" (scow %p p.i.apt) "/" txt)
mor
?~ mux
"# "
:(welp ":" mux "# ")
==
::
++ se-link :: connect to app
|= gyl=gill
^+ +>
=. +> ?. =(p.gyl src) +>
(se-emit ost %conf (se-path gyl) gyl %load src %home)
(se-join:(se-peer gyl /sole) gyl)
::
++ se-blit :: give output
|= bil=dill-blit
+>(biz [bil biz])
::
++ se-show :: show buffer, raw
|= lin=(pair ,@ud (list ,@c))
^+ +>
?: =(mir lin) +>
=. +> ?:(=(q.mir q.lin) +> (se-blit %pro q.lin))
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
+>(mir lin)
::
++ se-just :: adjusted buffer
|= lin=(pair ,@ud (list ,@c))
^+ +>
=. off ?:((lth p.lin edg) 0 (sub p.lin edg))
(se-show (sub p.lin off) (scag edg (slag off q.lin)))
::
++ se-view :: flush buffer
?: liv.maz
(se-just ~(ta-vew ta [& & ~zod %$] tar.maz))
?~ apt
se-view(liv.maz &)
%- se-just
~(ta-vew ta [& | i.apt] (~(got by feg) i.apt))
::
++ se-kill :: kill a source
=+ tup=apt
|- ^+ +>
?~ tup +>(apt ~)
$(tup +.tup, +> (se-nuke i.tup))
::
++ se-emit :: emit move
|= mov=move
%_(+> moz [mov moz])
::
++ se-path :: standard path
|= gyl=gill
[(scot %p src) (scot %p p.gyl) q.gyl ~]
::
++ se-poke :: send a poke
|= [gyl=gill par=pear]
(se-emit ost %poke (se-path gyl) gyl par)
::
++ se-peer
|= [gyl=gill pax=path]
(se-emit ost %peer (se-path gyl) gyl pax)
::
++ se-pull
|= gyl=gill
(se-emit ost %pull (se-path gyl) gyl ~)
::
++ se-tame
|= gyl=gill
^+ ta
~(. ta [& %| gyl] (~(got by feg) gyl))
::
++ se-diff :: receive results
|= [gyl=gill fec=sole-effect]
^+ +>
ta-abet:(ta-fec:(se-tame gyl) fec)
::
++ ta :: per target
|_ $: $: liv=? :: don't delete
mav=? :: showing master
gyl=gill :: target app
== ::
target :: target state
== ::
++ ta-abet :: resolve
^+ ..ta
=. liv.maz mav
?: mav
?. liv
(se-blit `dill-blit`[%qit ~])
+>(tar.maz +<+)
?. liv
=. ..ta (se-nuke gyl)
..ta(liv.maz =(~ apt))
%_(+> feg (~(put by feg) gyl +<+))
::
++ ta-ant :: toggle master
^+ .
?: mav
?~ apt ta-bel
%_ .
mav |
+<+ (~(got by feg) gyl)
tar.maz +<+
==
%_ .
mav &
+<+ tar.maz
feg (~(put by feg) gyl +<+)
==
::
++ ta-act :: send action
|= act=sole-action
^+ +>
?: mav
+>.$
+>.$(+> (se-poke gyl %sole-action act))
::
++ ta-aro :: hear arrow
|= key=?(%d %l %r %u)
^+ +>
?- key
%d =. ris ~
?. =(num.hit pos.hit)
(ta-mov +(pos.hit))
?: =(0 (lent buf.say.inp))
ta-bel
(ta-hom:ta-nex %set ~)
%l ?^ ris ta-bel
?: =(0 pos.inp) ta-bel
+>(pos.inp (dec pos.inp))
%r ?^ ris ta-bel
?: =((lent buf.say.inp) pos.inp)
ta-bel
+>(pos.inp +(pos.inp))
%u =. ris ~
?:(=(0 pos.hit) ta-bel (ta-mov (dec pos.hit)))
==
::
++ ta-bel .(+> (se-blit %bel ~)) :: beep
++ ta-cat :: mass insert
|= [pos=@ud txt=(list ,@c)]
^- sole-edit
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos i.txt] $(pos +(pos), txt t.txt)]
::
++ ta-cut :: mass delete
|= [pos=@ud num=@ud]
^- sole-edit
:- %mor
|-(?:(=(0 num) ~ [[%del pos] $(num (dec num))]))
::
++ ta-det :: send edit
|= ted=sole-edit
^+ +>
(ta-act %det [[his.ven.say.inp own.ven.say.inp] (sham buf.say.inp) ted])
::
++ ta-bac :: hear backspace
^+ .
?^ ris
?: =(~ str.u.ris)
ta-bel
.(str.u.ris (scag (dec (lent str.u.ris)) str.u.ris))
?: =(0 pos.inp)
.(+> (se-blit %bel ~))
=+ pre=(dec pos.inp)
(ta-hom(pos.inp pre) %del pre)
::
++ ta-ctl :: hear control
|= key=@ud
^+ +>
?+ key ta-bel
%a +>(pos.inp 0)
%b (ta-aro %l)
%c ta-bel(ris ~)
%d ?: &(=(0 pos.inp) =(0 (lent buf.say.inp)))
+>(liv |)
ta-del
%e +>(pos.inp (lent buf.say.inp))
%f (ta-aro %r)
%g ta-bel(ris ~)
%k =+ len=(lent buf.say.inp)
?: =(pos.inp len)
ta-bel
%- ta-hom(kil `(slag pos.inp buf.say.inp))
(ta-cut pos.inp (sub len pos.inp))
%l +>(+> (se-blit %clr ~))
%n (ta-aro %d)
%p (ta-aro %u)
%r ?~ ris
+>(ris `[pos.hit ~])
?: =(0 pos.u.ris)
ta-bel
(ta-ser ~)
%t =+ len=(lent buf.say.inp)
?: |(=(0 pos.inp) (lth len 2))
ta-bel
=+ sop=?:(=(len pos.inp) (dec pos.inp) pos.inp)
=. pos.inp +(sop)
%- ta-hom
:~ %mor
[%del sop]
[%ins (dec sop) (snag sop buf.say.inp)]
==
%u ?: =(0 pos.inp)
ta-bel
%- ta-hom(pos.inp 0, kil `(scag pos.inp buf.say.inp))
(ta-cut 0 pos.inp)
%v ta-ant
%x ?: =(~ apt) ta-bel
?: mav ta-bel
+>(apt (welp (slag 1 apt) [(snag 0 apt) ~]))
%y ?~ kil ta-bel
%- ta-hom(pos.inp (add pos.inp (lent u.kil)))
(ta-cat pos.inp u.kil)
==
::
++ ta-cru :: hear crud
|= [lab=@tas tac=(list tank)]
=. +>+> (se-blit %out (tuba (trip lab)))
(ta-tan tac)
::
++ ta-del :: hear delete
^+ .
?: =((lent buf.say.inp) pos.inp)
.(+> (se-blit %bel ~))
(ta-hom %del pos.inp)
::
++ ta-erl :: hear local error
|= pos=@ud
ta-bel(pos.inp (min pos (lent buf.say.inp)))
::
++ ta-err :: hear remote error
|= pos=@ud
(ta-erl (~(transpose cs say.inp) pos))
::
++ ta-fec :: apply effect
|= fec=sole-effect
^+ +>
?- -.fec
%bel ta-bel
%blk +>
%clr +>(+> (se-blit fec))
%det (ta-got +.fec)
%err (ta-err +.fec)
%mor |- ^+ +>.^$
?~ p.fec +>.^$
$(p.fec t.p.fec, +>.^$ ^$(fec i.p.fec))
%nex ta-nex
%pro (ta-pro +.fec)
%tan (ta-tan p.fec)
%sag +>(+> (se-blit fec))
%sav +>(+> (se-blit fec))
%txt $(fec [%tan [%leaf p.fec]~])
==
::
++ ta-dog :: change cursor
|= ted=sole-edit
%_ +>
pos.inp
=+ len=(lent buf.say.inp)
%+ min len
|- ^- @ud
?- -.ted
%del ?:((gth pos.inp p.ted) (dec pos.inp) pos.inp)
%ins ?:((lte pos.inp p.ted) +(pos.inp) pos.inp)
%mor |- ^- @ud
?~ p.ted pos.inp
$(p.ted t.p.ted, pos.inp ^$(ted i.p.ted))
%nop pos.inp
%set len
==
==
::
++ ta-got :: apply change
|= cal=sole-change
=^ ted say.inp (~(receive cs say.inp) cal)
(ta-dog ted)
::
++ ta-hom :: local edit
|= ted=sole-edit
^+ +>
=. +> (ta-det ted)
=. +> (ta-dog(say.inp (~(commit cs say.inp) ted)) ted)
+>
::
++ ta-met :: meta key
|= key=@ud
~& [%ta-met key]
+>
::
++ ta-mov :: move in history
|= sop=@ud
^+ +>
?: =(sop pos.hit) +>
%+ %= ta-hom
pos.hit sop
lay.hit %+ ~(put by lay.hit)
pos.hit
buf.say.inp
==
%set
%- (bond |.((snag (sub num.hit +(sop)) old.hit)))
(~(get by lay.hit) sop)
::
++ ta-nex :: advance history
%_ .
num.hit +(num.hit)
pos.hit +(num.hit)
ris ~
lay.hit ~
old.hit [buf.say.inp old.hit]
==
::
++ ta-pro :: set prompt
|= pom=sole-prompt
+>(pom pom(cad :(welp (scow %p p.gyl) ":" (trip q.gyl) cad.pom)))
::
++ ta-ret :: hear return
?. mav
(ta-act %ret ~)
=+ txt=(tufa buf.say.inp)
=+ fey=(rose txt sp-ukase:sp)
?- -.fey
%| (ta-erl (lent (tuba (scag p.fey txt))))
%& ?~ p.fey
(ta-erl (lent buf.say.inp))
=. +>+> (se-like u.p.fey)
=. pom pom.tar.maz
(ta-hom:ta-nex %set ~)
==
::
++ ta-ser :: reverse search
|= ext=(list ,@c)
^+ +>
?: |(?=(~ ris) =(0 pos.u.ris)) ta-bel
=+ tot=(weld str.u.ris ext)
=+ dol=(slag (sub num.hit pos.u.ris) old.hit)
=+ sop=pos.u.ris
=+ ^= ser
=+ ^= beg
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | &(=(i.a i.b) $(a t.a, b t.b))))
|= [a=(list ,@c) b=(list ,@c)] ^- ?
?~(a & ?~(b | |((beg a b) $(b t.b))))
=+ ^= sup
|- ^- (unit ,@ud)
?~ dol ~
?: (ser tot i.dol)
`sop
$(sop (dec sop), dol t.dol)
?~ sup ta-bel
(ta-mov(str.u.ris tot, pos.u.ris (dec u.sup)) (dec u.sup))
::
++ ta-tan :: print tanks
|= tac=(list tank)
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>+>.^$ (se-blit %out (tuba i.wol)))
::
++ ta-txt :: hear text
|= txt=(list ,@c)
^+ +>
?^ ris
(ta-ser txt)
%- ta-hom(pos.inp (add (lent txt) pos.inp))
:- %mor
|- ^- (list sole-edit)
?~ txt ~
[[%ins pos.inp i.txt] $(pos.inp +(pos.inp), txt t.txt)]
::
++ ta-vew :: computed prompt
|- ^- (pair ,@ud (list ,@c))
?^ ris
%= $
ris ~
cad.pom
:(welp "(reverse-i-search)'" (tufa str.u.ris) "': ")
==
=- [(add pos.inp (lent p.vew)) (weld (tuba p.vew) q.vew)]
^= vew ^- (pair tape (list ,@c))
?: vis.pom [cad.pom buf.say.inp]
:- ;: welp
cad.pom
?~ buf.say.inp ~
;: welp
"<"
(scow %p (end 4 1 (sham buf.say.inp)))
"> "
==
==
=+ len=(lent buf.say.inp)
|- ^- (list ,@c)
?:(=(0 len) ~ [`@c`'*' $(len (dec len))])
--
--
++ peer
|= [from pax=path]
^- (quip move +>)
:: ~& [%sole-peer ost src pax]
?< (~(has by bin) ost)
:- [ost %diff %dill-blit %pro [`@c`0x23 `@c`0x20 ~]]~
%= +>
bin
%+ ~(put by bin) ost
^- source
:* 80
0
~
~
:* %&
*(unit search)
*history
`sole-prompt`[%& %sole "{(scow %p our.hid)}# "]
*sole-command
==
~
[0 ~]
==
==
::
++ gull
|= way=wire ^- (pair ship gill)
?>(?=([@ @ @ ~] way) [(slav %p i.way) (slav %p i.t.way) i.t.t.way])
::
++ poke-dill-belt
|= [from bet=dill-belt]
^- (quip move +>)
:: ~& [%sole-poke ost src bet]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-poke-stale ost]
[~ +>.$]
=< se-abet
=< se-view
(~(se-belt se [~ ~] [src ost] u.yog) bet)
::
++ diff-sole-effect
|= [then fec=sole-effect]
^- (quip move +>)
:: ~& [%diff-sole-effect way]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-diff-stale ost way]
[~ +>.$]
=< se-abet
=< se-view
=+ yaw=(gull way)
(~(se-diff se [~ ~] [p.yaw ost] u.yog) q.yaw fec)
::
++ coup
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-coup-stale ost way]
[~ +>.$]
=< se-abet
=< se-view
=+ yaw=(gull way)
(~(se-drop se [[ost %flog ~ %crud %coup u.saw]~ ~] [p.yaw ost] u.yog) q.yaw)
::
++ reap
|= [then saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
:_ +> :_ ~
`move`[ost %flog ~ %crud %reap u.saw]
::
++ quit
|= then
^- (quip move +>)
=+ yog=(~(get by bin) ost)
?~ yog
~& [%sole-quit-stale ost way]
[~ +>.$]
=< se-abet
=< se-view
=+ yaw=(gull way)
(~(se-drop se [~ ~] [p.yaw ost] u.yog) q.yaw)
::
++ onto
|= [then saw=(each suss tang)]
:_ +>
?- -.saw
%| [[ost %flog ~ %crud `@tas`-.way `tang`p.saw] ~]
%& :: [ost %flog ~ %text "<{<p.saw>}>"]
~
==
::
++ pull
|= [from pax=path]
^- (quip move +>)
:: ~& [%sole-pull ost]
=^ moz +>
=< se-abet
=< se-view
~(se-kill se [~ ~] [our.hid ost] (~(got by bin) ost))
[moz +>.$(bin (~(del by bin) ost))]
--

213
base/ape/talk/core.hook → base/ape/talk.hoon
View File

@ -1,9 +1,13 @@
:: :: ::
:::: /hook/core/talk/app :: ::
:: :: ::
/? 314
/- *talk, *sole
/+ talk, sole
:::: /hoon/talk/app :: ::
:: :: ::
/? 314
/- *talk, *sole
/+ talk, sole
/= seed /~ !>(.)
/= talk-doc
/; |=(a=wain (turn a |=(b=cord [%txt "? {(trip b)}"])))
/: /===/pub/doc/talk/help /txt/
::
::::
::
@ -74,8 +78,10 @@
:: ::
++ work :: interface action
$% [%number p=? q=@ud] :: activate by number
[%help ~] :: print usage info
[%join p=(set partner)] ::
[%say p=speech] ::
[%eval p=twig q=cord] ::
[%invite p=span q=(list partner)] ::
[%banish p=span q=(list partner)] ::
[%target p=(set partner)] :: set active targets
@ -97,15 +103,16 @@
(runt [(sub len lez) '-'] nez)
:(welp pre (scag (dec len) nez) "+")
--
|_ [hid=hide house]
|_ [hid=bowl house]
++ ra :: per transaction
|_ [ost=bone moves=(list move)]
++ sh :: per console
|_ $: coz=(list command) :: talk actions
she=shell
==
++ sh-expr wide:(vang & [&1:% &2:% (scot %da now.hid) |3:%])
::
++ sh-scad :: command parser
=+ vag=(vang | [&1:% &2:% '0' |3:%])
=< work
|%
++ dare :: @dr
@ -124,7 +131,7 @@
++ pasp :: passport
;~ pfix pat
;~ pose
(stag %twitter ;~(pfix ;~(plug (jest 't') col) urs:ab))
(stag %twitter ;~(pfix (jest 't') col urs:ab))
==
==
::
@ -175,18 +182,14 @@
++ work
%+ knee *^work |. ~+
;~ pose
%+ stag %create
;~ pfix (jest %create)
;~ plug
;~(pfix ace pore)
;~(pfix ;~(plug ace cen) sym)
;~(pfix ace qut)
==
;~ (glue ace) (perk %create ~)
pore
;~(pfix cen sym)
qut
==
::
%+ stag %join
;~(pfix (jest %join) ;~(pfix ace parq))
::
;~((glue ace) (perk %join ~) parq)
;~(plug (perk %help ~) (easy ~))
(stag %number nump)
(stag %target parz)
==
@ -268,7 +271,6 @@
%- ~(gas in *(set partner))
(turn (~(tap by aud)) |=([a=partner *] a))
::
::
++ sh-poss :: passive update
|= lix=(set partner)
=+ sap=(sh-pare lix)
@ -287,14 +289,15 @@
::
++ sh-rend :: print on one line
|= gam=telegram
(sh-pass:(sh-fact %txt ~(tr-line tr man.she gam)) q.q.gam)
=+ lin=~(tr-line tr man.she gam)
(sh-pass:(sh-fact %txt lin) q.q.gam)
::
++ sh-numb :: print msg number
|= num=@ud
^+ +>
=+ bun=(scow %ud num)
:: =+ pad=(sub 36 (lent bun))
:: =+ now=`@da`(dis lat.hid 0xffff.ffff.ffff.ffff.0000.0000.0000.0000)
:: =+ now=`@da`(dis now.hid 0xffff.ffff.ffff.ffff.0000.0000.0000.0000)
%+ sh-fact %txt
(runt [(sub 15 (lent bun)) '-'] "[{bun}]")
::
@ -723,9 +726,13 @@
|= [inv=sole-edit buf=(list ,@c)]
^- (list sole-edit)
?~ buf ~
?: =(';' i.buf)
((sh-sane-rule sh-scad) inv (tufa t.buf))
?: =('@' i.buf)
=+ txt=(tufa buf)
?: =(& -:(rose txt aurf:urlp)) ~
?: =(';' -.txt)
((sh-sane-rule sh-scad) inv +.txt)
?: =('#' -.txt)
((sh-sane-rule sh-expr) inv +.txt)
?: =('@' -.txt)
(sh-sane-chat +.buf)
(sh-sane-chat buf)
::
@ -749,11 +756,16 @@
++ sh-pork :: parse work
^- (unit work)
?~ buf.say.she ~
?: =(';' -.buf.say.she)
(rust (tufa +.buf.say.she) sh-scad)
?: =('@' -.buf.say.she)
`[%say %lin | (crip (tufa +.buf.say.she))]
`[%say %lin & (crip (tufa buf.say.she))]
=+ txt=(tufa buf.say.she)
=+ rou=(rust txt aurf:urlp)
?^ rou `[%say %url u.rou]
?: =(';' -.txt)
(rust +.txt sh-scad)
?: =('#' -.txt)
(bind (rust +.txt sh-expr) |=(a=twig [%eval a (crip +.txt)]))
?: =('@' -.txt)
`[%say %lin | (crip +.txt)]
`[%say %lin & (crip txt)]
::
++ sh-lame :: send error
|= txt=tape
@ -769,6 +781,9 @@
|= cod=command
%_(+> coz [cod coz])
::
++ sh-twig-head ^- vase :: eval data
:(slop !>(`our=@p`our.hid) !>(`tym=@da`now.hid) !>(`eny=@uvI`eny.hid))
::
++ sh-work :: do work
|= job=work
^+ +>
@ -779,23 +794,26 @@
?- -.job
%number (number +.job)
%join (join +.job)
%eval (eval +.job)
%invite (invite +.job)
%banish (banish +.job)
%create (create +.job)
%target (target +.job)
%probe (probe +.job)
%help (help)
%say (say +.job)
==
::
++ activate :: from %number
|= gam=telegram
^+ +>+>+>
^+ ..sh-work
~& [%activate gam]
sh-prod(active.she `~(tr-pals tr man.she gam))
::
++ help |=(~ (sh-fact %mor talk-doc)) :: %help
++ join :: %join
|= lix=(set partner)
^+ +>+>+>
^+ ..sh-work
=+ loc=loc.system.she
%^ sh-tell %design man.she
:- ~
@ -811,20 +829,20 @@
::
++ invite :: %invite
|= [nom=span tal=(list partner)]
^+ +>+>+>
^+ ..sh-work
!!
::
++ banish :: %banish
|= [nom=span tal=(list partner)]
^+ +>+>+>
^+ ..sh-work
!!
::
++ create :: %create
|= [por=posture nom=span txt=cord]
^+ +>+>+>
^+ ..sh-work
?: (~(has in stories) nom)
(sh-lame "{(trip nom)}: already exists")
=. +>+>+>
=. ..sh-work
%^ sh-tell %design nom
:- ~
:+ *(set partner)
@ -838,7 +856,7 @@
::
++ number :: %number
|= [rel=? num=@ud]
^+ +>+>+>
^+ ..sh-work
=+ roy=(~(got by stories) man.she)
=. num
?. rel num
@ -850,17 +868,23 @@
::
++ probe :: inquire
|= cuz=station
^+ +>+>+>
^+ ..sh-work
~& [%probe cuz]
+>+>+>
..sh-work
::
++ eval :: run
|= [exe=twig txt=cord]
%^ say %fat
tank/[(sell (slap (slop sh-twig-head seed) exe))]~
[%exp txt]
::
++ say :: publish
|= sep=speech
^+ +>+>+>
=^ sir +>+>+> sh-uniq
%= +>+>+>.$
^+ ..sh-work
=^ sir ..sh-work sh-uniq
%= ..sh-work
coz :_ coz
[%publish [[sir sh-whom [lat.hid ~ sep]] ~]]
[%publish [[sir sh-whom [now.hid ~ sep]] ~]]
==
--
::
@ -1098,11 +1122,12 @@
~& [%bad-subscribe-story-c i.t.pax]
(ra-evil %talk-no-story)
=+ soy=~(. pa i.t.pax u.pur)
=^ who +>.$ (ra-human her)
=. soy ?.((~(has in vab) %a) soy (pa-watch:soy her))
=. soy ?.((~(has in vab) %x) soy (pa-master:soy her))
=. soy (pa-notify:soy her %hear who)
=. soy ?.((~(has in vab) %f) soy (pa-listen:soy her t.t.pax))
=^ who +>.$ (ra-human her)
pa-abet:(pa-notify:soy her %hear who)
pa-abet:soy
::
++ ra-think :: publish/review
|= [pub=? her=ship tiz=(list thought)]
@ -1322,7 +1347,7 @@
=+ ^= nol
?: =(%gone p.saz)
(~(del by locals) her)
(~(put by locals) her lat.hid saz)
(~(put by locals) her now.hid saz)
?: =(nol locals) +>.$
(pa-display(locals nol) viewers)
::
@ -1385,7 +1410,7 @@
(pa-sauce ost [%quit ~]~)
=+ ^= ruv ^- (unit river)
?: ?=(~ pax)
`[[%ud count] [%da (dec (bex 128))]]
`[[%ud ?:((lth count 64) 0 (sub count 64))] [%da (dec (bex 128))]]
?: ?=([@ ~] pax)
=+ say=(slay i.pax)
?. ?=([~ %$ ?(%ud %da) @] say) ~
@ -1489,23 +1514,6 @@
++ sn-curt :: render name in 14
|= mup=?
^- tape
=+ ^= syl
|= [len=@ud sez=(list cord)]
?> !=(0 len)
|- ^- tape
?~ sez ~
=+ nez=(trip i.sez)
=+ nel=(lent nez)
?: (gte nel len)
(welp (scag (dec len) nez) ">")
(welp nez $(sez t.sez))
::
?: =(p.one our.hid)
?: =(q.one man)
(sigh 14 ?:(mup "*=" "=") %$)
(sigh 14 ?:(mup "*%" "%") q.one)
?: =(p.one (sein our.hid))
(sigh 14 ?:(mup "*/" "/") q.one)
=+ rac=(clan p.one)
=+ raw=(scow %p p.one)
=. raw ?.(mup raw ['*' (slag 2 raw)])
@ -1630,8 +1638,8 @@
=+ eck=?:((~(has by aud) [%& our.hid man]) '*' '-')
=+ heb=?:(oug '>' '<')
=+ ^= baw
?: oug
~(te-whom te man tr-pals)
:: ?: oug
:: ~(te-whom te man tr-pals)
(~(sn-curt sn man [who (main who)]) |)
[heb eck (weld baw txt)]
::
@ -1640,13 +1648,24 @@
%- ~(gas in *(set partner))
(turn (~(tap by aud)) |=([a=partner *] a))
::
++ trim
|= [len=@u txt=tape]
?: (gth len (lent txt)) txt
(weld (scag (dec len) txt) "…")
::
++ tr-text
|= oug=?
^- tape
?+ -.sep ""
%url
(earn p.sep)
?+ -.sep ~&(tr-lost/sep "")
%fat
=+ rem=$(sep q.sep)
=- "{rem} {(trim (sub 60 (lent rem)) -)}"
?+ -.p.sep "..."
%tank ~(ram re %rose [" " `~] +.p.sep)
==
::
%url ['/' ' ' (earf p.sep)]
%exp ['#' ' ' (trip p.sep)]
%lin
=+ txt=(trip q.sep)
?: p.sep
@ -1656,41 +1675,41 @@
(weld " " txt)
::
%app
[' ' (trip p.sep)]
"[{(trip p.sep)}]: {(trip q.sep)}"
==
--
::
++ peer :: accept subscription
|= [from pax=path]
|= [pax=path]
^- [(list move) _+>]
~? !=(src our.hid) [%peer-talk-stranger src]
~? !=(src.hid our.hid) [%peer-talk-stranger src.hid]
:: ~& [%talk-peer src ost pax]
?: ?=([%sole *] pax)
?> =(our.hid src)
?< (~(has by shells) ost)
ra-abet:(~(ra-console ra ost ~) src t.pax)
:: ~& [%talk-peer-data ost src pax]
ra-abet:(~(ra-subscribe ra ost ~) src pax)
?> =(our.hid src.hid)
?< (~(has by shells) ost.hid)
ra-abet:(~(ra-console ra ost.hid ~) src.hid t.pax)
:: ~& [%talk-peer-data ost.hid src.hid pax]
ra-abet:(~(ra-subscribe ra ost.hid ~) src.hid pax)
::
++ poke-talk-command :: accept command
|= [from cod=command]
|= [cod=command]
^- [(list move) _+>]
:: ~& [%talk-poke-command src cod]
ra-abet:(~(ra-apply ra ost ~) src cod)
:: ~& [%talk-poke-command src.hid cod]
ra-abet:(~(ra-apply ra ost.hid ~) src.hid cod)
::
++ poke-sole-action :: accept console
|= [from act=sole-action]
ra-abet:(~(ra-sole ra ost ~) act)
|= [act=sole-action]
ra-abet:(~(ra-sole ra ost.hid ~) act)
::
++ diff-talk-report ::
|= [then rad=report]
|= [way=wire rad=report]
%+ etch-friend way |= [man=span cuz=station]
ra-abet:(~(ra-diff-talk-report ra ost ~) man cuz rad)
ra-abet:(~(ra-diff-talk-report ra ost.hid ~) man cuz rad)
::
++ coup-repeat ::
|= [then saw=(unit tang)]
|= [way=wire saw=(unit tang)]
%+ etch-repeat [%repeat way] |= [num=@ud src=@p man=span]
ra-abet:(~(ra-coup-repeat ra ost ~) [num src man] saw)
ra-abet:(~(ra-coup-repeat ra ost.hid ~) [num src man] saw)
::
++ etch :: parse wire
|= way=wire
@ -1716,34 +1735,34 @@
?>(?=(%repeat -.wer) (fun p.wer q.wer r.wer))
::
++ reap-friend ::
|= [then saw=(unit tang)]
|= [way=wire saw=(unit tang)]
^- (quip move +>)
?~ saw [~ +>]
%+ etch-friend [%friend way] |= [man=span cuz=station]
~& [%reap-friend-fail man cuz u.saw]
ra-abet:(~(ra-quit ra ost ~) man cuz)
ra-abet:(~(ra-quit ra ost.hid ~) man cuz)
::
++ quit-friend ::
|= then
|= way=wire
%+ etch-friend [%friend way] |= [man=span cuz=station]
ra-abet:(~(ra-retry ra ost ~) man cuz)
ra-abet:(~(ra-retry ra ost.hid ~) man cuz)
::
++ pull ::
|= [from pax=path]
|= [pax=path]
^- [(list move) _+>]
~& [%talk-pull src ost pax]
=^ moz +>.$ ra-abet:(~(ra-cancel ra ost ~) src pax)
[moz +>.$(shells (~(del by shells) ost))]
~& [%talk-pull src.hid ost.hid pax]
=^ moz +>.$ ra-abet:(~(ra-cancel ra ost.hid ~) src.hid pax)
[moz +>.$(shells (~(del by shells) ost.hid))]
::
::++ poke-bit
:: |= [from ~]
:: |= [~]
:: ^- (quip move +>)
:: :_ +>.$
:: =+ paf=/(scot %p our.hid)/try/(scot %da lat.hid)/talk/backlog/jam
:: [ost %info /jamfile our.hid (foal paf (jam +<+.+>.$))]~
:: =+ paf=/(scot %p our.hid)/try/(scot %da now.hid)/talk/backlog/jam
:: [ost.hid %info /jamfile our.hid (foal paf (jam +<+.+>.$))]~
::
++ prep
|= [from old=(unit house)]
|= [old=(unit house)]
^- (quip move +>)
?~ old
ra-abet:~(ra-init ra 0 ~)

7
base/ape/twif.hoon Normal file
View File

@ -0,0 +1,7 @@
/- *twitter
!:
|_ [bowl ~]
++ poke-noun |=(span (onwards [%peer / [our %twit] /user/[+<]]))
++ onwards |*([mark *] [[ost +<]~ +>.$])
++ diff-twit-feed |=([* a=(list twit-stat)] ?~(a `+>.$ ~&(i.a $(a t.a))))
--

218
base/ape/twit.hoon Normal file
View File

@ -0,0 +1,218 @@
:: Twitter daemon
::
:::: /hook/core/twit/app
::
/- *twitter
/+ twitter, talk
::
:::: ~fyr
::
|%
++ twit-path :: valid peer path
$% :: [%home ~] :: home timeline
[%user p=@t ~] :: user's tweets
[%post p=span:,@uv ~] :: status of status
==
::
++ axle :: app state
$: %0
kes=(map span keys:twit-do) :: auth
out=(map ,@uvI (each ,[span cord] stat)) :: sent tweets
ran=(map path ,[p=@ud q=@da]) :: polls active
fed=(jar path stat) :: feed cache
==
::
++ gift :: subscription action
$% [%quit ~] :: terminate
[%diff gilt] :: send data
==
++ gilt
$% [%twit-feed p=(list stat)] :: posts in feed
[%twit-stat p=stat] :: tweet accepted
[%ares term (list tank)]
==
::
++ move ,[bone card]
++ card :: arvo request
$? gift
$% [%them path ~ u=hiss] :: HTTP request
[%poke wire dock %talk-command command:talk] ::
[%wait path p=@da] :: timeout
== ==
::
++ sign :: arvo response
$% [%e %thou p=httr] :: HTTP result
[%t %wake ~] :: timeout ping
==
::
++ stat twit-stat :: recieved tweet
--
!:
::::
::
|_ [bowl axle]
++ any-auth ?~(kes (auth) (auth p.n.kes)) :: use any keys
++ auth :: build API door
|= a=span
~| [%no-auth a]
~(. twit (~(got by kes) a) now `@`eny)
::
++ cull :: remove seen tweets
|= [pax=path rep=(list stat)] ^+ rep
=+ pev=(sa (turn (~(get ja fed) pax) |=(stat id)))
(skip rep |=(stat (~(has in pev) id)))
::
++ done [*(list move) .]
++ dely :: next polling timeout
|= pax=path
^- [(unit time) _ran]
=+ cur=(~(get by ran) pax)
=+ tym=(add now (mul ~s8 (bex ?~(cur 0 p.u.cur))))
:: ~& dely/`@dr`(sub tym now)
?: &(?=(^ cur) (gte tym q.u.cur) (gth q.u.cur now))
[~ ran]
[`tym (~(put by ran) pax ?~(cur 0 (min 5 +(p.u.cur))) tym)]
::
++ wait :: ensure poll by path
|= [pax=path mof=(list move)]
=^ tym ran (dely pax)
:_ +>.$
?~ tym
:: ~& no-wait/ran
mof
:: ~& will-wait/u.tym
:- [ost %wait pax u.tym]
mof
::
++ poke-twit-do :: recieve request
|= act=twit-do
^+ [*(list move) +>]
?- -.q.act
%auth
:- [(print "authed @{(trip p.act)}")]~
+>.$(kes (~(put by kes) p.act p.q.act)) :: XX verify key
%post
=: out (~(put by out) p.q.act %& p.act q.q.act)
ran (~(del by ran) /peer/home)
==
%+ wait /peer/home
=+ mez=(stat-upda:(auth p.act) [%status q.q.act]~ ~)
[ost %them /post/(scot %uv p.q.act) ~ mez]~
==
::
++ wake-peer
|= [pax=path ~] ^+ done
~& twit-wake/peer/pax
:_ +>.$
?. (~(has by ran) peer/pax) :: ignore if retracted
~
=+ => |=([a=bone @ b=path] [b a])
pus=(~(gas ju *(jug path bone)) (turn (~(tap by sup)) .))
?~ (~(get ju pus) pax)
~
~& peer-again/[pax ran]
(pear | our pax)
::
++ thou
|= [pax=path hit=httr] ^+ done
?+ p.hit ~|([%unknown-code p.hit] !!)
429 :: Rate-limit
=. ran (~(put by ran) pax 6 now)
=+ lim=%.(%x-rate-limit-reset ;~(biff ~(get by (mo q.hit)) poja ni:jo))
=+ tym=?~(lim (add ~m7.s30 now) (add ~1970.1.1 (mul ~s1 u.lim)))
~& retrying-in/`@dr`(sub tym now)
:_(+>.$ [ost %wait pax tym]~)
::
200 :: OK
=+ jon=(need (poja q:(need r.hit)))
:: ~& twit-resp/%.(jon ?+(-.jon !! %o stat:twir, %a (ar:jo stat:twir)))
?+ pax ~|([%http-missed pax] !!)
[%post @ ~] :: post acknowledged
=+ ^= rep
~| [%bad-post jon]
(need %.(jon stat:twir))
=. out (~(put by out) (slav %uv i.t.pax) %| rep)
:_ +>.$
=+ pax=/[who.rep]/status/(rsh 3 2 (scot %ui id.rep))
:- (print (earn [& ~ `/com/twitter] `pax ~))
(spam pax (tweet-good rep))
[%peer *] :: feed data
=+ ^= rep
~| [%bad-feed jon]
(need %.(jon (ar:jo stat:twir)))
:: ~& got-feed/[(scag 5 (turn rep |=(stat id))) fed]
=+ ren=(cull t.pax rep) :: new messages
?~ ren
(wait pax ~) :: pump polling
:: ~& spam-feed/ren
=: ran (~(del by ran) pax) :: clear poll delay
fed (~(put by fed) t.pax rep) :: saw last message
==
(wait pax (spam t.pax [%diff twit-feed/(flop ren)] ~))
==
::
?(400 401 403 404) :: Err
=+ ^- git=gift
=+ err=%.(q:(need r.hit) ;~(biff poja mean:twir))
:^ %diff %ares %bad-http
[leaf/"HTTP Code {<p.hit>}" (turn (need err) mean:twip)]
?+ pax [[ost git]~ +>.$]
[%post @ ~]
[(spam pax git ~) +>.$]
==
==
++ tweet-good |=(rep=stat `(list gift)`~[[%diff %twit-stat rep] [%quit ~]])
++ peer |=(pax=path :_(+> (pear & src pax))) :: accept subscription
++ pear :: poll, possibly returning current data
|= [ver=? @ pax=path]
^- (list move)
?. ?=(twit-path pax)
~|([%missed-path pax] !!)
=> .(pax `twit-path`pax)
?: ?=(%post -.pax)
?. ver ~
=+ sta=(~(get by out) (slav %uv p.pax))
?. ?=([~ %| ^] sta) :: post not received
~
~[[ost %diff %twit-stat p.u.sta] [ost %quit ~]]
=+ ole=(~(get ja fed) pax)
:_ ^- (list move)
?. ver ~
?~ ole ~
[ost %diff %twit-feed (flop ole)]~
=- `move`[ost %them peer/pax ~ `hiss`-]
=+ opt=?~(ole ~ ['since_id' (lutt:twit id.i.ole)]~)
=+ aut=any-auth
?- -.pax
%user (stat-user:aut [(to-sd p.pax)]~ opt)
:: %home (stat-home:auth ~ opt)
==
::
++ to-sd :: parse user name/numb
|= a=span ^- sd:twit
~| [%not-user a]
%+ rash a
;~(pose (stag %user-id dem) (stag %screen-name user:twir))
::
:: ++ pull :: release subscription
:: |= ost=bone
:: ?. (~(has by sup) ost) `+>.$ :: XX should not occur
:: =+ [his pax]=(~(got by sup) ost)
:: ?: (lth 1 ~(wyt in (~(get ju pus) pax)))
:: `+>.$
:: =: ran (~(del by ran) [%peer pax])
:: fed (~(del by fed) pax)
:: ==
:: `+>.$
::
++ spam :: send by path
|= [a=path b=(list gift)] ^- (list move)
%- zing ^- (list (list move))
%+ turn (~(tap by sup))
|= [ost=bone @ pax=path]
?. =(pax a) ~
(turn b |=(c=gift [ost c]))
::
++ print
|=(mes=tape [ost %poke / [our %talk] (said our %twit now eny leaf/mes ~)])
--

123
base/ape/ucto/core.hook
View File

@ -1,123 +0,0 @@
:: :: ::
:::: /hook/core/acto/ape :: :: dependencies
:: :: ::
/- *sole :: structure
/+ sole :: library
:: :: ::
:::: :: :: structures
!: :: ::
=> |% :: board logic
++ board ,@ :: one-player bitfield
++ point ,[x=@ y=@] :: coordinate
++ game ,[who=? box=board boo=board] :: game state
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ get |=(point =(1 (cut 0 [(off +<) 1] bud))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) ::
-- ::
:: :: ::
:::: :: :: semantics
:: :: ::
++ go :: per game
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: ok move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ res ?: ~(win bo box) `"{~[(icon &)]} wins" :: result
?: ~(win bo boo) `"{~[(icon |)]} wins" ::
?: =(511 (con boo box)) `"tie :-(" ~ ::
++ row |= y=@ :~ (add y '1') :: print row
' ' ~(v at y 0) ::
' ' ~(v at y 1) ::
' ' ~(v at y 2) ::
== ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
-- ::
-- ::
:: :: ::
:::: :: :: server
:: :: ::
=> |% :: arvo structures
++ axle ,[%0 eye=face gam=game] :: agent state
++ card ,[%diff lime] :: update
++ face (pair (list ,@c) (map bone sole-share)) :: interface
++ lime ,[%sole-effect sole-effect] :: console update
++ move (pair bone card) :: cause and action
-- ::
=> |% :: parsers
++ colm (cook |=(a=@ (sub a '1')) (shim '1' '3')) :: row or column
++ come ;~(plug colm ;~(pfix fas colm)) :: coordinate
-- ::
|_ [hid=hide moz=(list move) axle] :: per agent
++ et ::
|_ [from say=sole-share] :: per console
++ abet +>(q.eye (~(put by q.eye) ost say)) :: continue
++ amok +>(q.eye (~(del by q.eye) ost)) :: discontinue
++ beep (emit %bel ~) :: bad user
++ delt |= cal=sole-change :: input line change
=^ cul say (remit:sole cal good) ::
?~ cul (park:abet(p.eye buf.say) | ~) ::
abet:beep:(emit det/u.cul) ::
++ emit |= fec=sole-effect ^+ +> :: send effect
+>(moz [[ost %diff %sole-effect fec] moz]) ::
++ emil |= fex=(list sole-effect) :: send effects
?~(fex +> $(fex t.fex, +> (emit i.fex))) ::
++ good |=((list ,@c) -:(rose (tufa +<) come)) :: valid input
++ kick |= point :: move command
=^ dud gam ~(m ~(at go gam) +<) ::
?. dud abet:beep =+ mus=~(res go gam) ::
(park:abet(gam ?^(mus *game gam)) %2 mus) ::
++ line =^ cal say (transmit:sole set/p.eye) :: update command
(emit %det cal) ::
++ make =+ dur=(rust (tufa p.eye) come) ::
?~ dur abet:beep ::
(kick:line(p.eye ~) +.dur) ::
++ mean |=((unit tape) ?~(+< +> (emit txt/+<+))) :: optional message
++ play |= lev=?(%0 %1 %2) :: update by level
?-(lev %0 +>, %1 line, %2 line:show:prom) ::
++ plow |= [lev=?(%0 %1 %2) mus=(unit tape)] :: complete print
abet:(mean:(play lev) mus) ::
++ prom %^ emit %pro %& :- %acto :: update prompt
": {~[(icon who.gam)]} to move (row/col): " ::
++ rend (turn `wall`~(tab go gam) |=(tape txt/+<)) :: table print
++ show (emit %mor rend) :: update board
++ sole ~(. cs say) :: console library
++ work |= act=sole-action :: console input
?:(?=(%det -.act) (delt +.act) make) ::
-- ::
++ abet [(flop moz) .(moz ~)] :: resolve core
++ flet |=(from ~(. et +< (~(got by q.eye) ost))) :: in old client
++ fret |=(from ~(. et +< *sole-share)) :: in new client
++ pals %+ turn (pale hid (prix /sole)) |= sink :: per console
[[p=p.+< q=q.+<] r=(~(got by q.eye) p.+<)] ::
++ park |= [lev=?(%0 %1 %2) mus=(unit tape)] :: general update
=+ pals |- ^+ +>.^$ ?~ +< +>.^$ ::
$(+< t.+<, +>.^$ (~(plow et i.+<) lev mus)) ::
:: :: ::
:::: :: :: events
:: :: ::
++ peer-sole :: console subscribe
|= [from *] =< abet ::
(plow:(fret +<-) %2 ~) ::
++ poke-sole-action :: console input
|= [from act=sole-action] =< abet ::
(work:(flet +<-) act) ::
++ prep |= [from old=(unit ,[(list move) axle])] :: initialize
=< abet ?~ old +> =< (park %2 ~) ::
+>(+<+ u.old) ::
++ pull-sole :: disconnect console
|= [from *] =< abet ::
amok:(flet +<-) ::
--

16
base/arvo/ames.hoon
View File

@ -413,7 +413,7 @@
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
tay=(cut 0 [27 5] mag) :: message type
==
?> =(7 vez)
?> =(0 vez)
?> =(chk (end 0 20 (mug bod)))
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
(kins tay)
@ -433,7 +433,7 @@
=+ tay=(ksin q.kec)
%+ mix
%+ can 0
:~ [3 7]
:~ [3 0]
[20 (mug bod)]
[2 yax]
[2 qax]
@ -1018,7 +1018,7 @@
++ gnaw :: gnaw:am
|= [kay=cape ryn=lane pac=rock] :: process packet
^- [p=(list boon) q=fort]
?. =(7 (end 0 3 pac)) [~ fox]
?. =(0 (end 0 3 pac)) [~ fox]
=+ kec=(bite pac)
?: (goop p.p.kec) [~ fox]
?. (~(has by urb.ton.fox) q.p.kec)
@ -1331,8 +1331,8 @@
(deer q.fud r.fud ?-(kay %dead ~, %good [~ s.fud]))
::
%carp
=+ zol=(~(get by olz.weg) s.fud)
?^ zol cock(kay u.zol)
:: =+ zol=(~(get by olz.weg) s.fud)
:: ?^ zol cock(kay u.zol)
=^ neb nys.weg
=+ neb=(~(get by nys.weg) s.fud)
?^ neb [u.neb nys.weg]
@ -1350,7 +1350,7 @@
:: ~& [%carp q.fud s.fud q.neb p.r.neb]
?: =(q.neb p.r.neb)
=: nys.weg (~(del by nys.weg) s.fud)
olz.weg (~(put by olz.weg) s.fud kay)
:: olz.weg (~(put by olz.weg) s.fud kay)
==
(golf p.neb r.neb)
=. +>.$ cock
@ -1399,7 +1399,7 @@
==
==
+>.$
(wool [/a hen] /q/pi ~ |)
(wool [/a/ping hen] /q/pi ~ |)
::
++ thaw :: thaw:ho:um:am
^+ . :: wakeup bomb
@ -1898,7 +1898,7 @@
?. &(?=(^ muc) ?=(^ luw)) ~
[~ `buck`[u.muc u.luw]]
?: ?=([%code ~] tyl)
[~ (end 6 1 (shaf %code (shax sec:ex:q:sen:u.gys)))]
[~ (end 6 1 (shaf %pass (shax sec:ex:q:sen:u.gys)))]
?: ?=([%will ~] tyl)
(rick mar our law.saf.u.gys)
~

1026
base/arvo/clay.hoon
View File

File diff suppressed because it is too large Load Diff

37
base/arvo/dill.hoon
View File

@ -43,20 +43,13 @@
++ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
[%diff p=cage] :: subscription output
== ::
++ suss (trel term ,@tas ,@da) :: config report
++ move ,[p=duct q=(mold note gift)] :: local move
++ note-ames :: weird ames move
$% [%make p=(unit ,@t) q=@ud r=@ s=?] ::
[%sith p=@p q=@uw r=?] ::
== ::
++ note-clay ::
$% [%font p=@p q=@tas r=@p s=@tas] ::
$% [%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%warp p=sock q=riff] :: wait for clay, hack
== ::
++ note-dill :: note to self, odd
@ -79,7 +72,6 @@
[%d note-dill] ::
[%g note-gall] ::
== == ::
++ riff ,[p=desk q=(unit rave)] :: see %clay
++ sign-ames ::
$% [%nice ~] ::
[%init p=ship] ::
@ -167,7 +159,7 @@
|= [err=@tas tac=(list tank)]
=+ ^= wol ^- wall
:- (trip err)
(zing (turn tac |=(a=tank (~(win re a) [0 wid]))))
(zing (turn (flop tac) |=(a=tank (~(win re a) [0 wid]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (from %out (tuba i.wol)))
@ -221,10 +213,13 @@
=+ myt=(flop (need tem))
=+ can=(clan our)
=. tem ~
=. moz :_(moz [hen %pass / %c %font our %home our %base])
=. moz ?. ?=(?(%king %czar) can) moz
:_(moz [hen %pass / %c %font our %kids our %base])
=. moz :_(moz [hen %pass / %c %merg our %home our %base %init])
=. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]])
=. +> ?: ?=(%czar can) +>
(sync %base (sein our) %kids)
=. +> (sync %home our %base)
=. +> ?. ?=(?(%king %czar) can) +>
(sync %kids our %base)
=. +> peer
|- ^+ +>+
?~ myt +>+
@ -259,6 +254,14 @@
:_(moz [hen %pass ~ %g %deal [our our] ram %peer /drum])
==
::
++ sync
|= syn=[desk ship desk]
%_ +>.$
moz
:_ moz
[hen %pass ~ %g %deal [our our] ram %poke %hood-sync -:!>(syn) syn]
==
::
++ pump :: send diff ack
%_ .
moz
@ -282,12 +285,7 @@
[%c %mere *]
?: ?=(%& -.p.sih)
+>.$
~| %dill-mere-fail
~| p.p.p.sih
|-
?~ q.p.p.sih !!
~> %mean.|.(i.q.p.p.sih) :: pull ford fail into stack trace
$(q.p.p.sih t.q.p.p.sih)
(mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
::
[%g %onto *]
:: ~& [%take-gall-onto +>.sih]
@ -305,6 +303,7 @@
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
%diff pump:(from ((hard dill-blit) q:`vase`+>+>.sih))
%doff !!
==
::
[%c %note *]

315
base/arvo/eyre.hoon
View File

@ -16,6 +16,7 @@
== == ::
$: %e :: to self
$% [%this p=? q=clip r=httq] :: proxied request
[%meta vase:,[%them (unit httr)]] :: type check
== == ::
$: %f :: to %ford
$% [%exec p=@p q=beak r=(unit silk)] ::
@ -39,7 +40,7 @@
$% [%thou p=httr] :: response for proxy
== == ::
$: %f :: by %ford
$% [%made p=@uvH q=(each gage tang)] ::
$% [%made p=@uvH q=gage] ::
[%news ~] ::
== == ::
$: %t :: by %time
@ -52,10 +53,12 @@
++ whir $| ~ :: wire subset
$% [%at p=hole q=whir] :: authenticated
[%ay p=span:ship q=span:,@uvH ~] :: remote duct
[%ha p=path:beak] :: GET request
[%he p=whir] :: HEAD request
[%hi p=mark ~] :: outbound HTTP
[%si ~] :: response done
[%of p=ixor q=$|(~ whir-of)] :: associated view
[%on p=span:,@uvH ~] :: dependency
[%to p=ixor q=span:ship r=term s=wire] :: associated app
== ::
++ whir-of ,[p=span:ship q=term r=wire] :: path in dock
-- ::
@ -184,7 +187,7 @@
=+ cuh=(turn `(list ,@t)`cug |=(a=@t set-cookie/a))
hit(q (weld cuh q.hit))
::
++ add-poll :: inject dependency
++ inject :: inject dependency
|= [dep=@uvH max=[[%html ~] [[%head ~] hed=marl] [[%body ~] tal=marl] ~]]
^- manx
=: hed.max :_(hed.max ;meta(charset "utf-8", urb_injected "");)
@ -194,7 +197,7 @@
max(hed :_(hed.max ;script@"/~/on/{<dep>}.js"(urb_injected "");))
::
++ add-json :: inject window.urb
|= [urb=json jaz=cord] ^- cord
|= [urb=json jaz=cord] ^- cord
=- (cat 3 (crip -) jaz)
"""
var _urb = {(pojo urb)}
@ -218,16 +221,129 @@
|= tan=tang
;html
;head
;meta(charset "utf-8");
;link(rel "stylesheet", href "/home/lib/base.css");
;title: server error
==
;body:div#c.err:pre:code:"{(wush 80 tan)}"
==
::
++ favi :: XX favicon
0w3.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~LX-.~~HW-.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.Rdjk~.VWuDL.-3wUf.~zEWe.~Yj4N.f~Y~f.P~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~-~LX.~~lBp.m~~nR.Zv~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.RZvn~.GqCF~.Qt7h~.Ya2wH.~0000.~M000.fY000.
3~0w8.2~Qx8.if~eP.IX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~fP.Y~QB9.ivY00.03~k5.1g~Z~.vT~~~.~~~~~.~~~~~.~~~~~.FWuD~.
CpCp~.P8OcL.Y0003.~0000.~M000.fY000.3~000.0~M00.0fY00.03~00.00~Nk.l5v-W.KHH~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~-QJ.bj~00.
00~M0.00fY0.003~6.hAp~S.FGqL-.6xEr~.oC9y~.NUu7L.Y0003.~0000.~M000.fY000.3~000.
0~M00.0fY00.03~00.00~M0.00fY0.003~0.000~N.sn5~~.fPY~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~Z7.hQvYr.6NL~0.000~M.000fY.0003~.0000~.
M000f.Y0003.~0000.~M000.fY000.3~000.0~M00.0fYJb.iT~sT.dP~Vu.nB~ZZ.vnT~a.iAF~M.
000fY.0003~.0000~.VGqCL.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~Y.D9OvY.B9in~.0000~.M000f.Y0003.~0000.~M000.fY000.3~000.0~M41.
0vZ1g.k7~Ha.OI~~n.RZv~~.~~~~~.~~~~~.~~~~~.HW-L~.jAVe~.M000f.YNcj7.~YLbO.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.-byUL.
ZzoSf.~3MYf.~M000.fY000.3~000.0~MQd.3vZik.Bb~Kb.yU~~P.Y~f~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~IXeP.~ezEW.~WGGG.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~pSt.D~DFW.u~Uu7.x~-tD.
pT~RZ.vn~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~IXe.
P~-LH.W~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~0000.00000.00000.00000.00000.50000.00002.000g0.00400.000w0.000a0.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.3~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.Rdjk~.~bOYL.~~~~~.~~~~~.~~TZ~.v-ZLr.T~r6N.I~Rtn.l~-rC.
VL~-~.LX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.ZLrS~.OMIbf.Z2gAb.~JHqS.~V-vD.~Y-fz.
X~000.0~M00.0fY00.03~00.00~S1.wof~U.-fz~~.~~~~~.~~~~~.~~~~~.~~~~~.~DV-v.ZDpSv.
~0000.~M000.fY000.3~000.0~Qp6.hL-FG.qD~LX.-~~Qt.7h~Yw.823~Y.LbO~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~LX-.~WCFG.vZtnl.T~rmR.J~Yf3.M~~~~.~~~~~.~~~~~.~~~~J.XuT~N.
Yv7~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~0000.00000.00000.00000.00000.1g000.00002.000g0.00200.000g0.000a0.
001kU.001gE.02000.g0082.00000.C0005.a00w0.04001.0g008.00g00
++ js :: static javascript
|%
++ poll :: dependency long-poll
++ poll :: dependency long-poll
'''
urb.tries = 0
urb.call = function() {
@ -311,24 +427,18 @@
++ etag
'''
if(!window.urb) window.urb = {}
urb.fetchTag = function(){
var tag = JSON.parse(this.getResponseHeader("etag"))
if(tag) urb.wasp(tag)
}
urb.headReq = function(url){
var xhr = new XMLHttpRequest()
xhr.open("HEAD", url)
xhr.onload = urb.fetchTag
xhr.send()
}
Array.prototype.map.call(document.querySelectorAll('script'), function(ele){
if((new URL(ele.src)).host == document.location.host)
urb.headReq(ele.src)
})
Array.prototype.map.call(document.querySelectorAll('link'), function(ele){
if((new URL(ele.href)).host == document.location.host)
urb.headReq(ele.href)
})
urb.waspFrom = function(sel,attr){
Array.prototype.map.call(document.querySelectorAll(sel),
function(ele){
if((new URL(ele[attr])).host != document.location.host) return;
var xhr = new XMLHttpRequest()
xhr.open("HEAD", ele[attr])
xhr.send()
xhr.onload = function(){
var tag = JSON.parse(this.getResponseHeader("etag"))
if(tag) urb.wasp(tag)
}})}
if(urb.wasp){urb.waspFrom('script','src'); urb.waspFrom('link','href')}
'''
--
++ xml
@ -478,6 +588,20 @@
q.ask (~(put by q.ask) p.ask hen u.p.kyz)
kes (~(put by kes) hen p.ask)
==
::
%hiss :: outbound cage
::?~ p.kyz :: XX cancel
:: =+ sud=(need (~(get by kes) hen))
:: %= +>.$
:: mow :_(mow [ged [%give %thus sud ~]])
:: q.ask (~(del by q.ask) sud)
:: kes (~(del by kes) hen)
:: ==
:: ~& eyre-them/(earn p.u.p.kyz)
=+ wir=hi//[p.kyz]
?: ?=(%hiss p.q.kyz)
(pass-note wir [%e %meta :(slop !>(%them) !>(~) q.q.kyz)])
(back wir %hiss q.kyz)
::
%they :: inbound response
=+ kas=(need (~(get by q.ask) p.kyz))
@ -539,8 +663,12 @@
::
%went +>.$
%thou
?> ?=([%ay ^] tee)
(ames-gram (slav %p p.tee) got/~ (slav %uv q.tee) |2.sih)
?+ -.tee !!
%ay (ames-gram (slav %p p.tee) got/~ (slav %uv q.tee) |2.sih)
%hi =+ cay=[%httr !>(`httr`p.sih)]
?: ?=(%httr p.tee) (give-sigh %& cay)
(back si/~ p.tee cay)
==
::
%unto :: XX horrible
=+ cuf=`cuft`+>.sih
@ -548,11 +676,12 @@
?(%coup %reap)
(axom tee ?~(p.cuf [%nice ~] [%mean `[-.cuf u.p.cuf]]))
::
%doff !!
%diff
?> ?=([%of @ ^] tee)
?. ?=(%json p.p.cuf)
::~> %slog.`rose/[" " "[" "]"]^~[>%backing< >p.p.cuf< (sell q.p.cuf)]
(back tee 0v0 %json p.cuf)
~> %slog.`%*(. >[%backing p.p.cuf %q-p-cuf]< &3.+> (sell q.p.cuf))
(back tee %json p.cuf)
(get-rush:(ire-ix p.tee) q.tee ((hard json) q.q.p.cuf))
::
%quit (axom tee [%mean ~])
@ -577,11 +706,18 @@
==
::
%made
?> ?=(?([%| *] [%& @ *]) q.sih)
?< ?=(%tabl -.q.sih)
=. our (need hov) :: XX
|- ^+ ..axon
?- tee
[?(%on %ay) *] ~|(e/ford/lost/-.tee !!)
$|(~ [?(%on %ay) *]) ~|(e/ford/lost/tee !!)
[%si ~] (give-sigh q.sih)
[%hi ^]
?: ?=(%| -.q.sih)
(give-sigh q.sih) :: XX crash?
=* cay p.q.sih
?> ?=(%hiss p.cay)
(pass-note tee [%e %meta :(slop !>(%them) !>(~) q.cay)])
[%he *] :: XX hack
=. ..axon $(tee p.tee)
%_ ..axon
@ -595,17 +731,11 @@
[%of ^]
?~ q.tee ~|(e/ford/lost/tee !!)
?: ?=(%| -.q.sih)
(print-tang p.q.sih)
((slog 0 p.q.sih) +>.^$) :: XX get-even %mean
%+ get-rush:(ire-ix p.tee) q.tee
=* cay p.q.sih
?> ?=(%json p.cay) :: XX others
((hard json) q.q.cay)
::
[%to ^]
?: ?=(%| -.q.sih)
(mean-json 500 ~ %cast-fail p.q.sih)
~| tee
(new-mess:(ire-ix p.tee) [(slav %p q.tee) r.tee] s.tee p.q.sih)
::
[%at ^]
?. ?=([%& %js ^] q.sih)
@ -617,16 +747,20 @@
=^ jon ..ya ~(stat-json ya p.tee cyz)
$(tee q.tee, q.q.p.q.sih (add-json jon q.q.cay))
::
~
[%ha *]
:: ~& e/ford/hen
?. ?=(%& -.q.sih)
(fail 404 p.sih p.q.sih)
=* cay p.q.sih
?. ?=(%mime p.cay)
=- (back tee p.sih %mime cay(q.q -))
=+ bek=-:(need (tome p.tee))
=+ bik=?+(r.bek bek [%ud %0] bek(r da/now))
=- (pass-note tee (ford-req bik [%flag p.sih -]))
=- `silk`[%cast %mime %done ~ cay(q.q -)]
?. ?=([%ud 0] r.bek) q.q.cay
?+ p.cay q.q.cay :: inject dependency long-poll
%urb =| urb=[[%html ~] [[%head ~] marl] [[%body ~] manx marl] ~]
.*(.(urb q.q.cay) !=((add-poll p.sih urb)))
.*(.(urb q.q.cay) !=((inject p.sih urb)))
==
~| q.q.cay
=+ ((hard ,[mit=mite rez=octs]) q.q.cay)
@ -643,11 +777,6 @@
(fail 500 0v0 >%exit< p.mul)
::
++ ire-ix |=(ire=ixor ~(. ix ire (~(got by wix) ire)))
++ print-tang
|= a=tang ^+ +>
?~ a +>
~> %slog.`i.a
$(a t.a)
::
++ ses-authed
|= ses=hole
@ -665,9 +794,8 @@
|=([him=ship gam=gram] (pass-note ~ %a %want [our him] [%e -.gam] +.gam))
::
++ back :: %ford bounce
|= [tea=whir dep=@uvH mar=mark cay=cage]
=+ sil=`silk`[%cast mar %flag dep %done ~ cay]
(pass-note tea (ford-req root-beak sil))
|= [tea=whir mar=mark cay=cage]
(pass-note tea (ford-req root-beak [%cast mar %done ~ cay]))
::
++ ford-kill (pass-note ~ %f [%exec our *beak ~]) :: XX unused
++ ford-req |=([bek=beak kas=silk] [%f [%exec our bek `kas]])
@ -675,8 +803,8 @@
++ fail
|= [sas=@ud dep=@uvH mez=tang]
^+ +>
:: (back ~ dep %tang !>(mez)) :: tang->urb chain may be source of failure
(give-html sas ~ (add-poll dep (render-tang mez)))
:: (back ha/~ dep %tang !>(mez)) ::tang->urb chain may be source of failure
(give-html sas ~ (inject dep (render-tang mez)))
::
++ give-html
|= [sas=@ud cug=(list ,@t) max=manx]
@ -696,6 +824,12 @@
+>(ded (~(del in ded) hen))
+>(mow :_(mow [hen %give %thou hit]))
::
++ give-sigh :: userspace done
|= res=(each cage tang)
=- +>.$(mow :_(mow [hen %give %sigh `cage`-]))
?. ?=(%| -.res) p.res
[%tang !>(p.res)]
::
++ mean-json |=([sas=@uG err=ares] (give-json sas ~ (ares-to-json err)))
++ nice-json |=(* (give-json 200 ~ (joba %ok %b &)))
::
@ -727,6 +861,7 @@
++ abet ..handle
++ done .
++ teba |*(a=$+(* ..handle) |*(b=* %_(done ..handle (a b))))
++ back (teba ^back)
++ give-html (teba ^give-html)
++ give-thou (teba ^give-thou)
++ give-json (teba ^give-json)
@ -822,65 +957,7 @@
[?(%ico %png) %favicon ~]
:- ~
%^ resp 200 image//png
0w3.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~LX-.~~HW-.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.Rdjk~.VWuDL.-3wUf.~zEWe.
~Yj4N.f~Y~f.P~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~-~LX.~~lBp.m~~nR.Zv~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.RZvn~.GqCF~.Qt7h~.Ya2wH.~0000.~M000.fY000.3~0w8.2~Qx8.if~eP.IX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~fP.
Y~QB9.ivY00.03~k5.1g~Z~.vT~~~.~~~~~.~~~~~.~~~~~.FWuD~.CpCp~.P8OcL.Y0003.~0000.~M000.fY000.3~000.0~M00.0fY00.03~00.00~Nk.l5v-W.KHH~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~-QJ.bj~00.00~M0.00fY0.003~6.hAp~S.FGqL-.6xEr~.oC9y~.NUu7L.Y0003.~0000.~M000.fY000.3~000.0~M00.0fY00.03~00.
00~M0.00fY0.003~0.000~N.sn5~~.fPY~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~Z7.hQvYr.6NL~0.000~M.000fY.0003~.0000~.M000f.Y0003.~0000.
~M000.fY000.3~000.0~M00.0fYJb.iT~sT.dP~Vu.nB~ZZ.vnT~a.iAF~M.000fY.0003~.0000~.VGqCL.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~Y.D9OvY.B9in~.0000~.M000f.Y0003.~0000.~M000.fY000.3~000.0~M41.0vZ1g.k7~Ha.OI~~n.RZv~~.~~~~~.~~~~~.~~~~~.HW-L~.jAVe~.M000f.YNcj7.~YLbO.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.-byUL.ZzoSf.~3MYf.~M000.fY000.3~000.0~MQd.3vZik.Bb~Kb.yU~~P.Y~f~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~IXeP.~ezEW.~WGGG.L~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~pSt.D~DFW.u~Uu7.x~-tD.pT~RZ.
vn~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~IXe.P~-LH.W~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~0000.00000.00000.00000.
00000.50000.00002.000g0.00400.000w0.000a0.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.
00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.00000.3~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.Rdjk~.~bOYL.~~~~~.~~~~~.~~TZ~.v-ZLr.T~r6N.I~Rtn.l~-rC.VL~-~.LX~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.ZLrS~.OMIbf.Z2gAb.~JHqS.~V-vD.~Y-fz.X~000.
0~M00.0fY00.03~00.00~S1.wof~U.-fz~~.~~~~~.~~~~~.~~~~~.~~~~~.~DV-v.ZDpSv.~0000.~M000.fY000.3~000.0~Qp6.hL-FG.qD~LX.-~~Qt.7h~Yw.823~Y.LbO~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~LX-.~WCFG.vZtnl.T~rmR.J~Yf3.M~~~~.~~~~~.~~~~~.~~~~J.XuT~N.Yv7~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.
~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~~~~~.~0000.00000.00000.00000.00000.1g000.00002.000g0.00200.
000g0.000a0.001kU.001gE.02000.g0082.00000.C0005.a00w0.04001.0g008.00g00
favi
::
[%txt %robots ~]
:- ~
@ -898,7 +975,7 @@
$(q.pok /index)
?. ((sane %tas) i.q.pok)
(tome q.pok)
`[[our i.q.pok da/now] (flop t.q.pok)]
`[[our i.q.pok ud/0] (flop t.q.pok)]
::
++ as-aux-request :: /~/... req parser
^- (unit perk)
@ -1013,7 +1090,8 @@
?(%beam %spur)
=+ ext=(fall p.pok %urb)
=+ bem=?-(-.hem %beam p.hem, %spur [root-beak p.hem])
=+ wir=?+(mef !! %get ~, %head [%he ~])
=+ wir=`whir`[%ha (tope -.bem ~)]
=. wir ?+(mef !! %get wir, %head [%he wir])
~| bad-beam/q.bem
?< =([~ 0] (sky %cw (tope bem(+ ~, r [%da now]))))
=- ?.(aut [%& %| -] [%| (pass-note -)]) :: XX properly
@ -1037,10 +1115,8 @@
%mess
:- %|
=^ orx ..ya ?:(is-anon new-view:for-client [(need grab-oryx) ..ya])
=+ [vew=(ire-ix (oryx-to-ixor orx)) cay=[%json !>(`json`s.hem)]]
?: ?=(%json q.hem) ((teba new-mess.vew) p.hem r.hem cay)
%+ pass-note [%to (oryx-to-ixor orx) (scot %p p.p.hem) q.p.hem r.hem]
(ford-req root-beak [%cast q.hem %done ~ cay])
=+ vew=(ire-ix (oryx-to-ixor orx))
((teba new-mess.vew) p.hem r.hem q.hem %json !>(`json`s.hem))
::
%poll
?: ?=([~ %js] p.pok) :: XX treat non-json cases?
@ -1111,7 +1187,8 @@
?. ?| (~(has in aut.yac) him.ham)
?~(paz.ham | =(u.paz.ham load-secret))
==
~|(try/`@t`load-secret !!) :: XX security
~& code=`@t`load-secret
~|([%try 'code' %in %console] !!) :: XX security
=^ jon ..ya stat-json:(logon:yac him.ham)
=. cug.yac :_(cug.yac (set-cookie %ship (scot %p him.ham)))
(give-json 200 cug.yac jon)
@ -1285,12 +1362,12 @@
[+(p.eve) (~(put by q.eve) p.eve a)]
::
++ new-mess
|= [a=dock b=wire c=cage] ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %poke c])
|= [a=dock b=wire c=mark d=cage] ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %punk c d])
::
++ add-subs
|= [a=dock %json b=wire c=path] ^+ ..ix
(hurl-note [a b] [%g %deal [him -.a] +.a %peer c])
(hurl-note [a b] [%g %deal [him -.a] +.a %peel %json c])
::
++ del-subs :: XX per path?
|= [a=dock %json b=wire c=path] ^+ ..ix

477
base/arvo/ford.hoon
View File

@ -6,7 +6,6 @@
=> =~
:: structures
|%
::
++ gift gift-ford :: out result <-$
++ heel path :: functional ending
++ kiss kiss-ford :: in request ->$
@ -55,8 +54,9 @@
dep=(set beam) :: dependencies
== ::
++ calx :: concrete cache line
$% [%hood p=calm q=(pair beam gage) r=hood] :: compile
$% [%hood p=calm q=(pair beam cage) r=hood] :: compile
[%bake p=calm q=(trel mark beam heel) r=(unit vase)]:: load
[%lilt p=calm q=beak r=(jug mark mark)] :: translation graph
[%slit p=calm q=[p=type q=type] r=type] :: slam type
[%slim p=calm q=[p=type q=twig] r=(pair type nock)]:: mint
[%slap p=calm q=[p=vase q=twig] r=vase] :: compute
@ -73,6 +73,7 @@
keg=(map (pair term beam) cage) :: block results
kig=[p=@ud q=(map ,@ud ,[p=care q=beam])] :: blocks
== ::
++ gagl (list (pair gage gage))
-- ::
|% ::
++ calf :: reduce calx
@ -81,6 +82,7 @@
?+ sem !!
%hood ?>(?=(%hood -.cax) r.cax)
%bake ?>(?=(%bake -.cax) r.cax)
%lilt ?>(?=(%lilt -.cax) r.cax)
%slap ?>(?=(%slap -.cax) r.cax)
%slam ?>(?=(%slam -.cax) r.cax)
%slim ?>(?=(%slim -.cax) r.cax)
@ -105,12 +107,21 @@
^- cafe ::
[(grom p.a p.b) (grum q.a q.b)] ::
:: ::
++ faun |=([a=cafe b=vase] (fine a `gage`[%noun b])) :: vase to cage
++ feel |=([a=cafe b=gage] (fine a q.b)) :: cage to vase
++ fest :: bolt to success
|= a=beam ::
|*([b=cafe c=*] (flag a (fine b [~ u=c]))) ::
:: ::
++ faun (flux |=(a=vase [%& %noun a])) :: vase to gage
++ feel (flux |=(a=cage q.a)) :: cage to vase
++ furl :: unwrap gage to cage
|= [a=cafe b=gage] ^- (bolt cage)
?- -.b
%tabl (flaw a >%bad-marc< ~)
%| (flaw a p.b)
%& (fine a p.b)
==
::
++ fret :: lift error
|= a=(bolt gage) ^- (bolt gage)
?. ?=(%2 -.q.a) a
[p.a [%0 p.q.a `gage`[%| q.q.a]]]
::
++ fine |* [a=cafe b=*] :: bolt from data
[p=`cafe`a q=[%0 p=*(set beam) q=b]] ::
++ flaw |= [a=cafe b=tang] :: bolt from error
@ -122,6 +133,8 @@
b
:: ::
++ flue |=(a=cafe (fine a ~)) :: cafe to empty
++ flux |* a=_,* :: bolt lift (fmap)
|*([b=cafe c=_+<.a] (fine b (a c))) ::
++ grom :: merge sets
|* [one=(set) two=(set)]
^+ one
@ -207,6 +220,7 @@
?- -.+.sih
%writ
?~ p.sih +>.$
:: ~& writ/tea
=+ [dap=(~(got by deh.bay) dep) bem=`beam`[bek sup]]
=- ?~(dop con con(deh.bay (~(put by deh.bay) dep dop)))
^- [dop=$|(~ _dap) con=_+>.$]
@ -262,6 +276,8 @@
%lime lime
%lima lima
%link link
%lion lion
%lily lily
%lope lope
%make make
%meow meow
@ -319,6 +335,11 @@
%2 nuf
%1 nuf
%0
:: ~& :- %clef-new
:: ?+ sem `@tas`sem
:: %hood [%hood (tope &1.q.q.hoc)]
:: %bake [%bake `mark`&1.q.q.hoc (tope &2.q.q.hoc)]
:: ==
:- p=(came p.nuf `calx`[sem `calm`[now p.q.nuf] q.q.hoc q.q.nuf])
q=q.nuf
==
@ -363,7 +384,7 @@
%1 q.nuf
%2 [%2 p=(grom `_p.q.nuf`p.q.hoc p.q.nuf) q=q.q.nuf]
%0 [%0 p=(grom `_p.q.nuf`p.q.hoc p.q.nuf) q=q.q.nuf]
== ==
== ==
::
++ coup :: toon to bolt
|= cof=cafe
@ -413,6 +434,22 @@
==
fun
::
++ tabl-run :: apply to all elems
|= fun=(burg cage gage)
|= [cof=cafe gag=gage]
^- (bolt gage)
?. ?=(%tabl -.gag)
(cope (furl cof gag) fun)
%+ cope
|- ^- (bolt (list (pair gage gage)))
?~ p.gag (fine cof ~)
%+ cope (fret ^$(gag q.i.p.gag, cof cof))
|= [cof=cafe val=gage]
%+ cope ^$(p.gag t.p.gag, cof cof)
|= [cof=cafe rex=(list (pair gage gage))]
(fine cof [[p.i.p.gag val] rex])
(flux |=(rex=(list (pair gage gage)) [%tabl rex]))
::
++ dash :: process cache
|= cof=cafe
^+ +>
@ -424,17 +461,15 @@
%. [cof kas kos]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] (make cof p))
|=([cof=cafe p=silk q=silk] (make cof q))
|=([cof=cafe p=silk q=silk] (cope (make cof p) furl))
|=([cof=cafe p=silk q=silk] (cope (make cof q) furl))
==
|= [cof=cafe cay=gage coy=gage]
?. &(?=(@ p.cay) ?=(@ p.coy))
(flaw cof leaf/"bad diff marc" ~)
|= [cof=cafe cay=cage coy=cage]
?. =(p.cay p.coy)
%+ flaw cof :_ ~
leaf/"diff on data of different marks: {(trip p.cay)} {(trip p.coy)}"
?: =(q.q.cay q.q.coy)
(fine cof %null [%atom %n] ~)
(fine cof %& %null [%atom %n] ~)
%+ cope (fang cof p.cay)
|= [cof=cafe pro=vase]
?. (slab %grad p.pro)
@ -461,12 +496,17 @@
=+ for=((soft ,@tas) q:(slap gar [%cnzy %form]))
?~ for
(flaw cof leaf/"bad ++form:grad" ~)
(fine cof u.for dif)
(fine cof %& u.for dif)
==
::
++ daze :: remember depends
|= dep=(set beam)
^+ [*@uvH deh.bay]
=. dep
=< (sa (skip (~(tap in dep)) .))
|= dap=beam ^- ?
?~ s.dap |
=>(.(s.dap t.s.dap) |((~(has in dep) dap) $))
?~ dep [0v0 deh.bay]
=+ hap=(sham dep)
?: (~(has by deh.bay) hap)
@ -480,7 +520,7 @@
=. ..exec (dash p.bot)
?- -.q.bot
%0 =^ dep deh.bay (daze p.q.bot)
amok:(expo [%made dep %& q.q.bot])
amok:(expo [%made dep q.q.bot])
%2 =^ dep deh.bay (daze p.q.bot)
amok:(expo [%made dep %| q.q.bot])
%1 =+ zuk=(~(tap by p.q.bot) ~)
@ -498,13 +538,13 @@
++ fade :: compile to hood
|= [cof=cafe for=mark bem=beam]
^- (bolt hood)
%+ cool |.(leaf/"ford: fade {<[(tope bem)]>}")
%+ cope (make cof [%bake for bem ~])
|= [cof=cafe cay=gage]
:: %+ cool |.(leaf/"ford: fade {<[(tope bem)]>}")
%+ cope (cope (make cof [%bake for bem ~]) furl)
|= [cof=cafe cay=cage]
%+ (clef %hood) (fine cof bem(r [%ud 0]) cay)
^- (burg (pair beam gage) hood)
|= [cof=cafe bum=beam cay=gage]
:: ~& fade/clef-miss/bem
^- (burg (pair beam cage) hood)
|= [cof=cafe bum=beam cay=cage]
:: ~& fade/clef-miss/bem
=+ rul=(fair bum)
?. ?=(@ q.q.cay)
(flaw cof ~)
@ -516,10 +556,8 @@
++ fang :: protocol door
|= [cof=cafe for=mark]
^- (bolt vase)
=+ pax=/door/[for]/mar
%+ cope
(fade cof %hook [bek pax])
abut:(meow [bek pax] ~)
%+ cope (make cof [%core (norm ska bek /[for]/mar)])
;~(cope furl feel)
::
++ fair :: hood parsing rule
|= bem=beam
@ -678,12 +716,10 @@
%. [cof kas kos]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] (make cof p))
|=([cof=cafe p=silk q=silk] (make cof q))
|=([cof=cafe p=silk q=silk] (cope (make cof p) furl))
|=([cof=cafe p=silk q=silk] (cope (make cof q) furl))
==
|= [cof=cafe cay=gage coy=gage]
?. &(?=(@ p.cay) ?=(@ p.coy))
(flaw cof leaf/"bad join marc: {<p.cay>} {<p.coy>}" ~)
|= [cof=cafe cay=cage coy=cage]
%+ cope (fang cof for)
|= [cof=cafe pro=vase]
?. (slab %grad p.pro)
@ -704,7 +740,7 @@
leaf/"join on data of bad marks: {(trip p.cay)} {(trip p.coy)}"
leaf/"expected mark {(trip u.fom)}"
?: =(q.q.cay q.q.coy)
(fine cof cay)
(fine cof %& cay)
?. (slab %join p.gar)
(flaw cof leaf/"no ++join:grad" ~)
%+ cope
@ -713,8 +749,8 @@
(slop q.cay q.coy)
|= [cof=cafe dif=vase]
?@ q.dif
(fine cof %null dif)
(fine cof u.fom (slot 3 dif))
(fine cof %& %null dif)
(fine cof %& u.fom (slot 3 dif))
==
::
++ mash
@ -723,12 +759,10 @@
%. [cof r.mas r.mos]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] (make cof p))
|=([cof=cafe p=silk q=silk] (make cof q))
|=([cof=cafe p=silk q=silk] (cope (make cof p) furl))
|=([cof=cafe p=silk q=silk] (cope (make cof q) furl))
==
|= [cof=cafe cay=gage coy=gage]
?. &(?=(@ p.cay) ?=(@ p.coy))
(flaw cof leaf/"bad mash marc: {<p.cay>} {<p.coy>}" ~)
|= [cof=cafe cay=cage coy=cage]
%+ cope (fang cof for)
|= [cof=cafe pro=vase]
?. (slab %grad p.pro)
@ -750,9 +784,9 @@
leaf/"mash on data of bad marks: {(trip p.cay)} {(trip p.coy)}"
leaf/"expected mark {(trip u.fom)}"
?: =(q.q.cay q.q.coy)
(fine cof cay)
(fine cof %& cay)
?. (slab %mash p.gar)
(fine cof %null [%atom %n] ~)
(fine cof %& %null [%atom %n] ~)
%+ cope
%^ maul cof
(slap (slap pro [%cnzy %grad]) [%cnzy %mash])
@ -762,8 +796,7 @@
q.cay
q.coy
==
|= [cof=cafe dif=vase]
(fine cof u.fom dif)
(flux |=(dif=vase [%& u.fom dif]))
==
::
++ kale :: mutate
@ -772,21 +805,23 @@
%+ cope
|- ^- (bolt (list (pair wing vase)))
?~ muy (flue cof)
%+ cope (make cof q.i.muy)
|= [cof=cafe cay=gage]
%+ cope (cope (make cof q.i.muy) furl)
|= [cof=cafe cay=cage]
%+ cope ^$(muy t.muy)
|= [cof=cafe rex=(list (pair wing vase))]
(fine cof [[p.i.muy q.cay] rex])
|= [cof=cafe yom=(list (pair wing vase))]
%+ cope (make cof kas)
|= [cof=cafe cay=gage]
%- tabl-run
|= [cof=cafe cay=cage]
%+ cope (keel cof q.cay yom)
|= [cof=cafe vax=vase]
(fine cof p.cay vax)
(flux |=(vax=vase [%& p.cay vax]))
::
++ keel :: apply mutations
|= [cof=cafe suh=vase yom=(list (pair wing vase))]
^- (bolt vase)
%+ cool => |=([a=wing b=type *] [a b])
|.(leaf/"ford: keel {<p.suh>} {<(turn yom +)>}")
%^ maim cof
%+ slop suh
|- ^- vase
@ -801,27 +836,33 @@
$(yom t.yom, axe (peg axe 3))
::
++ lace :: load and check
|= [cof=cafe for=mark bem=beam arg=heel]
^- (bolt (unit vase))
|= [cof=cafe for=mark bem=beam]
^- (bolt (unit (burg heel vase)))
%+ cope (lend cof bem)
|= [cof=cafe arc=arch]
?^ q.arc
(cope (cope (liar cof bem) (lake for)) (fest (norm ska bem)))
?: (~(has by r.arc) %hook)
%+ cope (fade cof %hook bem)
|= [cof=cafe hyd=hood]
%+ cope (cope (abut:(meow bem arg) cof hyd) (lake for))
(fest (norm ska bem))
(flue cof)
%+ (flux some) cof
|= [cof=cafe arg=heel] ^- (bolt vase)
%+ cool |.(leaf/"ford: load {<for>} {<(tope bem)>}")
(cope (liar cof bem) (lake for))
?. (~(has by r.arc) %hook)
(flue cof)
%+ cope (lend cof bem(s [%hook s.bem]))
|= [cof=cafe arc=arch]
?~ q.arc
(flue cof)
%+ (flux some) cof
|= [cof=cafe arg=heel] ^- (bolt vase)
%+ cool |.(leaf/"ford: hook {<for>} {<(tope bem)>}")
%+ cope (fade cof %hook bem)
|= [cof=cafe hyd=hood]
(cope (abut:(meow bem arg) cof hyd) (lake for))
::
++ lake :: check/coerce
|= for=mark
|= [cof=cafe sam=vase]
^- (bolt vase)
%+ cool |.(leaf/"ford: check {<[for bek `@p`(mug q.sam)]>}")
?: ?=(?(%gate %core %door) for)
:: ~& [%lake-easy for bek]
(fine cof sam)
?: ?=(?(%hoon %hook) for)
=+ mas=((soft ,@t) q.sam)
?~ mas
@ -872,20 +913,21 @@
::
++ lear :: load vase
|= [cof=cafe bem=beam]
^- (bolt cage)
^- (bolt gage)
=+ von=(save ~ %cx bem)
?~ von
[p=*cafe q=[%1 [[%x bem ~] ~ ~]]]
?~ u.von
(flaw cof leaf/"lear: file unavailable" (smyt (tope bem)) ~)
(fine cof u.u.von)
(flaw cof leaf/"file unavailable" (smyt (tope bem)) ~)
(fine cof %& u.u.von)
::
++ lend :: load arch
|= [cof=cafe bem=beam]
^- (bolt arch)
=+ von=(save ~ %cy bem)
?~ von [p=cof q=[%1 [%y bem ~] ~ ~]]
(fine cof ((hard arch) q.q:(need u.von)))
%+ flag (norm ska bem)
(fine cof ?>(?=([~ %arch ^] u.von) ((hard arch) q.q.u.u.von)))
::
++ liar :: load vase
|= [cof=cafe bem=beam]
@ -894,47 +936,80 @@
?~ von
[p=*cafe q=[%1 [[%x bem ~] ~ ~]]]
?~ u.von
(flaw cof leaf/"liar: file unavailable" (smyt (tope bem)) ~)
(flaw cof leaf/"file not found" (smyt (tope bem)) ~)
(fine cof q.u.u.von)
::
++ lily :: translation targets
|= [cof=cafe for=mark]
^- (bolt (list ,@tas))
|= [cof=cafe for=mark] ^- (bolt (set ,@tas))
%+ cope (lilt cof)
|= [cof=cafe lil=(jug mark mark)]
(fine cof (~(get ju lil) for))
::
++ lilt
|= cof=cafe ^- (bolt (jug mark mark))
%+ (clef %lilt) (fine cof bek)
^- (burg beak (jug mark mark))
|= [cof=cafe bek=beak]
=. ^bek bek
%+ cope (lend cof [bek /mar])
|= [cof=cafe arc=arch]
:: =- =+((cope - |=([cafe lil=(jug mark mark)] ~&(lil=lil (flue cof)))) +<)
=+ all=(~(tap by r.arc))
|- ^- (bolt (jug mark mark))
?~ all (flue cof)
%+ cope $(cof cof, all t.all)
|= [cof=cafe lil=(jug mark mark)]
=* for p.i.all
=+ raf=(fang cof for)
?: =(%2 -.q.raf) (fine p.raf ~)
%+ cope raf
?: ?=(%2 -.q.raf)
=. q.q.raf :_(q.q.raf leaf/"! {<`mark`for>} build failed, ignoring.")
((slog 0 (flop q.q.raf)) (fine cof lil))
%+ cope `(bolt vase)`raf
|= [cof=cafe vax=vase]
%+ fine cof
%- ~(gas ju lil)
~| weg=(jam 3 p.vax)
%+ weld
^- (list ,@tas)
?. (slob %garb p.vax) ~
=+ gav=((soft (list ,@tas)) q:(slap vax [%cnzy %garb]))
?~(gav ~ u.gav)
^- (list ,[mark mark])
?. (slob %grab p.vax) ~
=+ gab=(slap vax [%cnzy %grab])
:: =+ opt=(skip (sloe p.gap) |=(fro=mark =(fro %noun)))
(turn (sloe p.gab) |=(fro=mark [fro for]))
?. (slob %grow p.vax) ~
=+ gow=(slap vax [%cnzy %grow])
(sloe p.gow)
(turn (sloe p.gow) |=(too=mark [for too]))
::
++ lima :: load at depth
|= [cof=cafe for=mark bem=beam arg=heel]
%+ (clef %bake) [p=cof q=[%0 p=[bem `~] q=[for bem arg]]]
|= [cof=cafe for=mark bem=beam arg=heel]
^- (bolt (unit vase))
%+ cope (lend cof bem)
|= [cof=cafe arc=arch]
^- (bolt (unit vase))
?: (~(has by r.arc) for)
(lace cof for bem(s [for s.bem]) arg)
=+ haz=(turn (~(tap by r.arc) ~) |=([a=@tas b=~] a))
?~ haz (flue cof)
%+ cope (lion cof for haz)
%+ cope
%+ cope (lend cof bem)
|= [cof=cafe arc=arch] ^- (bolt (map mark (burg heel vase)))
?~ r.arc (flue cof)
%+ cope $(r.arc l.r.arc)
|= [cof=cafe lam=(map mark (burg heel vase))]
%+ cope ^$(r.arc r.r.arc, cof cof)
|= [cof=cafe ram=(map mark (burg heel vase))]
=. for p.n.r.arc
%+ cope
?. ((sane %tas) for) (flue cof)
(lace cof for bem(s [for s.bem]))
|= [cof=cafe nod=(unit (burg heel vase))]
%+ fine cof
?^(nod [[for u.nod] lam ram] (~(uni by lam) ram))
|= [cof=cafe mal=(map mark (burg heel vase))]
=+ lit=(~(get by mal) for)
?^ lit
(cope (u.lit cof arg) (flux some))
=+ opt=(sa (turn (~(tap by mal)) head)) :: XX asymptotics
%+ cope (lion cof for opt)
|= [cof=cafe wuy=(list ,@tas)]
?~ wuy (flue cof)
%+ cope (make cof %bake i.wuy bem arg)
|= [cof=cafe hoc=gage]
%+ cope (lope cof i.wuy t.wuy q.hoc)
|= [cof=cafe vax=vase]
((fest bem) cof vax)
::
%+ cope ((~(got by mal) i.wuy) cof arg)
|= [cof=cafe hoc=vase]
(cope (lope cof i.wuy t.wuy hoc) (flux some))
++ lime :: load beam
|= [cof=cafe for=mark bem=beam arg=heel]
=+ [mob=bem mer=(flop arg)]
@ -943,19 +1018,19 @@
|= [cof=cafe vux=(unit vase)]
?^ vux (fine cof u.vux)
?~ s.mob
%+ flag
(norm ska mob)
(flaw cof leaf/"beam unavailable" (smyt (tope bem)) ~)
%+ flaw cof
~[leaf/"build {<for>}" leaf/"no usable ancestors" (smyt (tope bem))]
^$(s.mob t.s.mob, mer [i.s.mob mer])
::
++ link :: translate
|= [cof=cafe too=mark for=mark vax=vase]
^- (bolt vase)
:: %+ cool |.(leaf/"ford: link {<too>} {<for>} {<p.vax>}")
?: =(too for) (fine cof vax)
?: |(=(%noun for) =(%$ for))
((lake too) cof vax)
%+ cope (fang cof for)
|= [cof=cafe pro=vase]
|= [cof=cafe pro=vase] ^- (bolt vase)
?: &((slob %grow p.pro) (slob too p:(slap pro [%cnzy %grow])))
%+ cope (keel cof pro [[%& 6]~ vax]~)
|= [cof=cafe pox=vase]
@ -969,40 +1044,30 @@
`(slap gab [%cnzy for])
?~ zat
(flaw cof [%leaf "ford: no link: {<[for too]>}"]~)
~| [%link-maul for too]
(maul cof u.zat vax)
::
++ lion :: translation search
|= [cof=cafe too=@tas fro=(list ,@tas)]
^- (bolt (list ,@tas))
=| war=(set ,@tas)
=< -:(apex (fine cof fro))
|%
++ apex
|= rof=(bolt (list ,@tas))
^- [(bolt (list ,@tas)) _+>]
?. ?=(%0 -.q.rof) [rof +>.$]
?~ q.q.rof
[[p.rof [%0 p.q.rof ~]] +>.$]
=^ orf +>.$ (apse p.rof i.q.q.rof)
?. ?=(%0 -.q.orf)
[orf +>.$]
?~ q.q.orf
$(p.rof p.orf, q.q.rof t.q.q.rof)
[[p.orf [%0 (grom p.q.rof p.q.orf) q.q.orf]] +>.$]
::
++ apse
|= [cof=cafe for=@tas]
^- [(bolt (list ,@tas)) _+>]
?: =(for too)
[(fine cof [too ~]) +>.$]
?: (~(has in war) for) [(flue cof) +>]
=. war (~(put in war) for)
=^ hoc +>.$ (apex (lily cof for))
:_ +>.$
%+ cope hoc
|= [cof=cafe ked=(list ,@tas)]
(fine cof ?~(ked ~ [for ked]))
--
|= [cof=cafe too=mark fro=(set mark)]
:: ~& lion/[too=too fro=(sa fro)]
^- (bolt (list mark))
=| $: war=(map mark (list mark))
pax=(list mark) won=[p=mark q=(qeu mark)]
==
%. [cof fro]
|= [cof=cafe fro=(set mark)] ^- (bolt (list mark))
?: =(too p.won)
(fine cof (flop pax))
=+ for=(skip (~(tap by fro)) ~(has by war))
=. for (sort for aor) :: XX useful?
=: q.won (~(gas to q.won) for)
war (~(gas by war) (turn for |=(mark [+< pax])))
==
?: =(~ q.won)
(flue cof)
=. won ~(get to q.won)
%+ cope (lily cof p.won)
..$(pax [p.won (~(got by war) p.won)])
::
++ lope :: translation pipe
|= [cof=cafe for=mark yaw=(list mark) vax=vase]
@ -1015,7 +1080,7 @@
++ mail :: cached mint
|= [cof=cafe sut=type gen=twig]
^- (bolt (pair type nock))
%+ (clef %slim) (fine cof sut gen)
%+ (clef %slim) (fine cof sut gen)
|= [cof=cafe sut=type gen=twig]
=+ puz=(mule |.((~(mint ut sut) [%noun gen])))
?- -.puz
@ -1034,28 +1099,27 @@
++ make :: reduce silk
|= [cof=cafe kas=silk]
^- (bolt gage)
:: ~& [%make (,@tas -.kas)]
?- -.kas
^
%. [cof p.kas q.kas]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] ^$(cof cof, kas p.kas))
|=([cof=cafe p=silk q=silk] ^$(cof cof, kas q.kas))
==
|=([cof=cafe p=silk q=silk] (cope ^$(cof cof, kas p.kas) furl))
|=([cof=cafe p=silk q=silk] (cope ^$(cof cof, kas q.kas) furl))
== :: XX merge %tabl
::
|= [cof=cafe bor=gage heg=gage] ^- (bolt gage)
[p=cof q=[%0 ~ [%$ (slop q.bor q.heg)]]]
|= [cof=cafe bor=cage heg=cage] ^- (bolt gage)
(faun cof (slop q.bor q.heg))
==
::
%bake
:: ~& [%bake-start (tope q.kas)]
%+ cool |.(leaf/"ford: bake {<p.kas>} {<(tope q.kas)>}")
:: ~& > [p.kas (tope q.kas)]
:: %+ cool |.(leaf/"ford: bake {<p.kas>} {<(tope q.kas)>}")
%+ cope (lima cof p.kas q.kas r.kas)
|= [cof=cafe vux=(unit vase)]
?~ vux
(flaw cof leaf/"bake failed" (smyt (tope q.kas)) ~)
(fine cof [p.kas u.vux])
(flaw cof leaf/"file not found" (smyt (tope q.kas)) ~)
(fine cof [%& p.kas u.vux])
::
%boil
^- (bolt gage)
@ -1064,49 +1128,57 @@
|= [cof=cafe bem=beam]
%+ cope (lime cof p.kas bem r.kas)
|= [cof=cafe vax=vase]
(fine cof `gage`[p.kas vax])
(fine cof `gage`[%& p.kas vax])
::
%bunt
%+ cool |.(leaf/"ford: bunt {<p.kas>}")
?: ?=(?(%hoon %hook) p.kas)
(fine cof p.kas [%atom %t] '')
(fine cof %& p.kas [%atom %t] '')
%+ cope (fang cof p.kas)
|= [cof=cafe tux=vase]
(fine cof [p.kas (slot 6 tux)])
(fine cof [%& p.kas (slot 6 tux)])
::
%call
:: %+ cool |.(leaf/"ford: call {<`@p`(mug kas)>}")
%. [cof p.kas q.kas]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] ^$(cof cof, kas p))
|=([cof=cafe p=silk q=silk] (cope ^$(cof cof, kas p) furl))
|=([cof=cafe p=silk q=silk] ^$(cof cof, kas q))
==
::
|= [cof=cafe gat=gage sam=gage]
(maul cof q.gat q.sam)
::
|= [cof=cafe vax=vase]
(fine cof %noun vax)
|= [cof=cafe gat=cage sam=gage]
%. [cof sam]
%- tabl-run
|= [cof=cafe sam=cage]
(cope (maul cof q.gat q.sam) faun)
==
::
%cast
%+ cool |.(leaf/"ford: cast {<p.kas>}")
%+ cope $(kas q.kas)
|= [cof=cafe cay=gage]
%- tabl-run
|= [cof=cafe cay=cage]
^- (bolt gage)
%+ cool |.(leaf/"ford: casting {<p.cay>} to {<p.kas>}")
?. ?=(@ p.cay)
(flaw cof leaf/"bad cast marc" ~)
%+ cope (link cof p.kas p.cay q.cay)
|= [cof=cafe vax=vase]
(fine cof [p.kas vax])
%+ cope (lion cof p.kas p.cay `~)
|= [cof=cafe wuy=(list ,@tas)]
%+ cope
?~ wuy
(link cof p.kas p.cay q.cay)
(lope cof i.wuy t.wuy q.cay)
(flux |=(vax=vase [%& p.kas vax]))
::
%core
%+ cool |.(leaf/"ford: core {<(tope p.kas)>}")
%+ cope (cope (fade cof %hoon p.kas) abut:(meow p.kas ~))
(flux |=(cor=vase [%& %core cor]))
::
%diff
%+ cool |.(leaf/"ford: diff {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}")
(diff cof p.kas q.kas)
::
%done [cof %0 p.kas q.kas]
%done [cof %0 p.kas %& q.kas]
%dude (cool |.(p.kas) $(kas q.kas))
%dune
?~ q.kas [cof [%2 p.kas [%leaf "no data"]~]]
@ -1142,46 +1214,42 @@
%+ cool |.(leaf/"ford: pact {<`@p`(mug p.kas)>} {<`@p`(mug q.kas)>}")
(pact cof p.kas q.kas)
::
%plan
%+ cope (abut:(meow p.kas q.kas) cof r.kas)
|= [cof=cafe vax=vase]
(fine cof %noun vax)
::
%reef (fine cof %noun pit)
%plan (cope (abut:(meow p.kas q.kas) cof r.kas) faun)
%reef (faun cof pit)
%ride
%+ cool |.(leaf/"ford: ride {<`@p`(mug kas)>}")
%+ cope $(kas q.kas)
|= [cof=cafe cay=gage]
%- tabl-run
|= [cof=cafe cay=cage]
%+ cope (maim cof q.cay p.kas)
|= [cof=cafe vax=vase]
(fine cof %noun vax)
(faun cof vax)
::
%tabl
%+ cope
|- ^- (bolt (pair (list (pair marc marc)) vase))
?~ p.kas (fine cof ~ *vase)
%+ cope (make cof p.i.p.kas)
|- ^- (bolt (list (pair gage gage)))
?~ p.kas (fine cof ~)
%+ cope (fret (make cof p.i.p.kas))
|= [cof=cafe key=gage]
%+ cope (make cof q.i.p.kas)
%+ cope (fret (make cof q.i.p.kas))
|= [cof=cafe val=gage]
%+ cope ^^$(p.kas t.p.kas)
|= [cof=cafe rex=(list (pair marc marc)) rey=vase]
(fine cof [[p.key p.val] rex] (slop (slop q.key q.val) rey))
|= [cof=cafe rex=(list (pair marc marc)) rey=vase]
(fine cof [%tabl rex] rey)
%+ cope ^^$(p.kas t.p.kas, cof cof)
|= [cof=cafe rex=(list (pair gage gage))]
(fine cof [[key val] rex])
(flux |=(rex=(list (pair gage gage)) [%tabl rex]))
::
%vale
%+ cool |.(leaf/"ford: vale {<p.kas>} {<q.kas>} {<`@p`(mug r.kas)>}")
%+ cope (lave cof p.kas q.kas r.kas)
|= [cof=cafe vax=vase]
(fine cof `cage`[p.kas vax])
(flux |=(vax=vase `gage`[%& p.kas vax]))
::
%volt
%+ cool |.(leaf/"ford: volt {<p.q.kas>}")
%+ cope $(kas [%bunt p.q.kas])
|= [cof=cafe cay=gage]
%- tabl-run
|= [cof=cafe cay=cage]
^- (bolt gage)
[cof %0 p.kas p.q.kas p.q.cay q.q.kas]
[cof %0 p.kas %& p.q.kas p.q.cay q.q.kas]
==
::
++ malt :: cached slit
@ -1282,7 +1350,7 @@
?~ src (fine cof ..body)
%+ cope (wilt cof i.src)
|= [cof=cafe sel=_..body]
^$(cof cof, src t.src, ..body sel)
^$(src t.src, ..body sel, cof cof)
::
++ chad :: atomic list
|= [cof=cafe bax=vase doe=term hon=horn]
@ -1298,8 +1366,7 @@
%+ cope $(poy t.poy)
|= [cof=cafe nex=(list (pair ,@ vase))]
%+ cope (chap(s.how [q.i.poy s.how]) cof bax hon)
|= [cof=cafe elt=vase]
(fine cof [[p.i.poy elt] nex])
(flux |=(elt=vase [[p.i.poy elt] nex]))
|= [cof=cafe yal=(list (pair ,@ vase))]
%+ fine cof
|- ^- vase
@ -1318,9 +1385,11 @@
|= [cof=cafe lef=(map ,@ vase)]
%+ cope `(bolt (map ,@ vase))`^$(cof cof, r.arc r.r.arc)
|= [cof=cafe rig=(map ,@ vase)]
%+ cope (chap(s.how [p.n.r.arc s.how]) cof bax hon)
|= [cof=cafe nod=vase]
(fine cof [[p.n.r.arc nod] lef rig])
=+ nod=(chap(s.how [p.n.r.arc s.how]) cof bax hon)
?: ?=(%2 -.q.nod)
(fine cof (~(uni by lef) rig))
%+ cope nod
(flux |=(nod=vase [[p.n.r.arc nod] lef rig]))
|= [cof=cafe doy=(map ,@ vase)]
%+ fine cof
|- ^- vase
@ -1342,18 +1411,16 @@
%day (chad cof bax %dr p.hon)
%dub
%+ cope $(hon q.hon)
|= [cof=cafe vax=vase]
(fine cof [[%face p.hon p.vax] q.vax])
(flux |=(vax=vase [[%face p.hon p.vax] q.vax]))
::
%fan
%+ cope
|- ^- (bolt (list vase))
?~ p.hon (flue cof)
%+ cope ^$(hon i.p.hon)
%+ cope ^$(cof cof, hon i.p.hon)
|= [cof=cafe vax=vase]
%+ cope ^$(cof cof, p.hon t.p.hon)
|= [cof=cafe tev=(list vase)]
(fine cof [vax tev])
(flux |=(tev=(list vase) [vax tev]))
|= [cof=cafe tev=(list vase)]
%+ fine cof
|- ^- vase
@ -1403,7 +1470,7 @@
(flaw cof [%leaf "type error: {<p.hon>} {<q.hon>}"]~)
(fine cof [p.tug q.vax])
::
%toy (cope (make cof %boil p.hon how ~) feel)
%toy (cope (cope (make cof %boil p.hon how ~) furl) feel)
==
::
++ head :: consume structures
@ -1416,8 +1483,7 @@
?. =(`hoof`q.i.bir `hoof`p.u.byf)
(flaw cof [%leaf "structure mismatch: {<~[p.u.byf q.i.bir]>}"]~)
$(bir t.bir)
=+ bem=(hone ?:(p.i.bir %gate %core) %sur q.i.bir)
%+ cope (fade cof %hook bem)
%+ cope (fade cof %hoon (hone %sur q.i.bir))
|= [cof=cafe hyd=hood]
%+ cope (apex(boy ~) cof hyd)
|= [cof=cafe sel=_..head]
@ -1434,11 +1500,11 @@
^^$(cof cof, bir t.bir)
::
++ hone :: plant hoof
|= [for=@tas way=@tas huf=hoof]
|= [way=@tas huf=hoof]
^- beam
?~ q.huf
how(s ~[for p.huf way])
[[q.u.q.huf q.how p.u.q.huf] ~[for p.huf way]]
how(s ~[p.huf way])
[[q.u.q.huf q.how p.u.q.huf] ~[p.huf way]]
::
++ neck :: consume libraries
|= [cof=cafe bir=(list hoof)]
@ -1452,8 +1518,7 @@
?. =(`hoof`i.bir `hoof`p.u.byf)
(flaw cof [%leaf "library mismatch: {<~[p.u.byf i.bir]>}"]~)
$(bir t.bir)
=+ bem=(hone %core %lib i.bir)
%+ cope (fade cof %hook bem)
%+ cope (fade cof %hoon (hone %lib i.bir))
|= [cof=cafe hyd=hood]
%+ cope (apex(zeg goz, boy ~) cof hyd)
|= [cof=cafe sel=_..neck]
@ -1479,8 +1544,7 @@
%+ cope (fade cof %hoon p.hop)
|= [cof=cafe hyd=hood]
%+ cope (apex(boy ~) cof hyd)
|= [cof=cafe sel=_..wilt]
(fine cof sel(boy [[%tssg boy.sel] boy]))
(flux |=(sel=_..wilt sel(boy [[%tssg boy.sel] boy])))
=+ [all=(lark (slat %tas) arc) sel=..wilt]
%+ cope
|- ^- (bolt (pair (map term foot) ,_..wilt))
@ -1511,12 +1575,10 @@
%. [cof kas kos]
;~ cope
;~ coax
|=([cof=cafe p=silk q=silk] (make cof p))
|=([cof=cafe p=silk q=silk] (make cof q))
|=([cof=cafe p=silk q=silk] (cope (make cof p) furl))
|=([cof=cafe p=silk q=silk] (cope (make cof q) furl))
==
|= [cof=cafe cay=gage coy=gage]
?. &(?=(@ p.cay) ?=(@ p.coy))
(flaw cof leaf/"bad pact marc" ~)
|= [cof=cafe cay=cage coy=cage] ^- (bolt gage)
?: ?=(?(%hoon %hook) p.cay)
?. ?=(%txt-diff p.coy)
(flaw cof leaf/"{<p.cay>} mark with bad diff type: {<p.coy>}" ~)
@ -1528,7 +1590,7 @@
=- (flaw cof leaf/"{<p.cay>} data with bad diff" -)
[>type=p.q.coy< >shouldbe=-:!>(*(urge cord))< ~]
=+ pac=(role (lurk (lore (cat 3 u.txt '\0a')) u.dif))
(fine cof p.cay [%atom %t] (end 3 (dec (met 3 pac)) pac))
(fine cof %& p.cay [%atom %t] (end 3 (dec (met 3 pac)) pac))
%+ cope (fang cof p.cay)
|= [cof=cafe pro=vase]
?. (slab %grad p.pro)
@ -1556,8 +1618,7 @@
%^ maul cof
(slap (slap pox [%cnzy %grad]) [%cnzy %pact])
q.coy
|= [cof=cafe pat=vase]
(fine cof p.cay pat)
(flux |=(pat=vase [%& p.cay pat]))
==
::
++ resp
@ -1623,6 +1684,7 @@
::
++ load :: highly forgiving
|= old=axle
=. pol.old (~(run by pol.old) |=(baby +<(jav ~)))
..^$(+>- old)
::=. old
:: ?. ?=([%0 *] old) old :: remove at 1
@ -1632,12 +1694,13 @@
:: ?> ?=([n=[p=* q=[tad=* dym=* deh=* jav=*]] l=* r=*] +.old)
:: :- [p.n.+.old [tad.q.n.+.old dym.q.n.+.old deh.q.n.+.old ~]]
:: [$(+.old l.+.old) $(+.old r.+.old)]
:: =+ lox=((soft axle) old)
:: ^+ ..^$
:: ?~ lox
:: ~& %ford-reset
:: ..^$
:: ..^$(+>- u.lox)
::|= old=*
::=+ lox=((soft axle) old)
::^+ ..^$
::?~ lox
:: ~& %ford-reset
:: ..^$
::..^$(+>- u.lox)
::
++ scry
|= [fur=(unit (set monk)) ren=@tas who=ship syd=desk lot=coin tyl=path]

328
base/arvo/gall.hoon
View File

@ -22,6 +22,7 @@
++ cote :: ++ap note
$% [%meta p=@tas q=vase] ::
[%send p=ship q=cush] ::
[%hiss p=mark q=cage]
== ::
++ cove (pair bone (mold cote cuft)) :: internal move
++ move ,[p=duct q=(mold note-arvo gift-arvo)] :: typed move
@ -33,8 +34,8 @@
pol=(map ship mast) :: apps by ship
== ::
++ gest :: subscriber data
$: sup=(map bone (pair ship path)) :: subscribers
pus=(jug path bone) :: srebircsbus
$: sup=bitt :: incoming subscribers
neb=boat :: outgoing subscribers
qel=(map bone ,@ud) :: queue meter
== ::
++ mast :: ship state
@ -65,7 +66,7 @@
tyc=stic :: statistics
ged=gest :: subscribers
hav=vase :: running state
pup=scup :: update control
byk=beak :: update control
zam=scar :: opaque ducts
== ::
++ sofa :: queue for blocked
@ -114,7 +115,7 @@
::
++ mo-conf :: configure
|= [dap=dude lum=culm]
(mo-boot dap ?:((~(has by bum) dap) %old %new) p.lum)
(mo-boot dap ?:((~(has by bum) dap) %old %new) p.p.lum q.p.lum da/now)
::
++ mo-pass :: standard pass
|= [pax=path noh=note-arvo]
@ -127,22 +128,25 @@
++ mo-okay :: valid agent core
|= vax=vase
^- ?
(~(nest ut -:!>(*hide)) %| p:(slot 12 vax))
=+ bol=(slew 12 vax)
?~ bol |
(~(nest ut p.u.bol) %| -:!>(*bowl))
::
++ mo-boom :: complete new boot
|= [dap=dude pup=scup dep=@uvH gux=(each gage tang)]
|= [dap=dude byk=beak dep=@uvH gux=gage]
^+ +>
?- -.gux
%tabl ~|(%made-tabl !!)
%|
=. +> (mo-bold dap dep)
=. +> (mo-bold byk dap dep)
=. +> (mo-give %onto %| p.gux)
+>
%&
?> ?=(@ p.p.gux)
?. (mo-okay q.p.gux)
(mo-give %onto %| [%leaf "{<dap>}: bogus core"]~)
=. +> (mo-bold dap dep)
=. +> (mo-born dap pup q.p.gux)
=. +> (mo-bold byk dap dep)
=. +> (mo-born dap byk q.p.gux)
=+ old=+>.$
=+ wag=(ap-prop:(ap-abed:ap dap [%high [~ our]]) ~)
?^ -.wag
@ -153,14 +157,14 @@
==
::
++ mo-born :: new seat
|= [dap=dude pup=scup hav=vase]
|= [dap=dude byk=beak hav=vase]
=+ sat=*seat
%_ +>.$
bum
%+ ~(put by bum) dap
%_ sat
mom hen
pup pup
byk byk
hav hav
p.zam 1
q.zam [[[~ ~] 0] ~ ~]
@ -169,32 +173,34 @@
==
::
++ mo-boon :: complete old boot
|= [dap=dude pup=scup dep=@uvH gux=(each gage tang)]
|= [dap=dude byk=beak dep=@uvH gux=gage]
^+ +>
?. (~(has by bum) dap)
=+ sut=(~(get by bum) dap)
?~ sut
~& [%gall-old-boon dap]
+>
=. +> (mo-bold dap dep)
+>.$
=. bum (~(put by bum) dap u.sut(byk byk))
=. +>.$ (mo-bold byk dap dep)
?- -.gux
%tabl ~|(%made-tabl !!)
%| (mo-give %onto %| p.gux)
%& ?> ?=(@ p.p.gux)
ap-abet:(ap-peep:(ap-abed:ap dap [%high [~ our]]) q.p.gux)
==
::
++ mo-bold :: wait for dep
|= [dap=dude dep=@uvH]
|= [byk=beak dap=dude dep=@uvH]
^+ +>
%+ mo-pass [%sys %dep dap ~]
%+ mo-pass [%sys %dep (scot %p p.byk) q.byk dap ~]
[%f %wasp our dep]
::
++ mo-boot :: create ship
|= [dap=dude how=?(%new %old) pup=scup]
|= [dap=dude how=?(%new %old) byk=beak]
^+ +>
:: ~& [%mo-boot dap how pup]
%+ mo-pass [%sys how dap (scot %p p.pup) q.pup ~]
=+ bek=[p.pup q.pup [%da now]]
:: ~& [%mo-boot dap how byk]
%+ mo-pass [%sys how dap (scot %p p.byk) q.byk (scot r.byk) ~]
^- note-arvo
[%f %exec our bek `[%boil %core [bek [dap %ape ~]] ~]]
[%f %exec our byk `[%core [byk [dap %ape ~]]]]
::
++ mo-away :: foreign request
|= [him=ship caz=cush] ::
@ -212,8 +218,11 @@
=^ num +>.$ (mo-bale him)
=+ ^= roc ^- rook
?- -.q.caz
%peel !!
%poke [%m p.p.q.caz q.q.p.q.caz]
%pull [%u ~]
%puff !!
%punk !!
%peer [%s p.q.caz]
==
%+ mo-pass
@ -276,28 +285,52 @@
?~ cup ~
[~ `tang`[[%leaf (trip p.u.cup)] q.u.cup]]
::
++ mo-chew :: reverse build path
|= pax=path
^- beak
?> ?=([@ @ @ ~] pax)
[(slav %p i.pax) i.t.pax da/(slav %da i.t.t.pax)]
::
++ mo-cyst :: take in /sys
|= [pax=path sih=sign-arvo]
^+ +>
?+ -.pax !!
%dep :: update
?> ?=([%f %news *] sih)
?> ?=([@ ~] t.pax)
=+ sot=(~(get by bum) i.t.pax)
?~ sot
~& [%mo-cyst-none i.t.pax]
+>.$
(mo-boot i.t.pax %old pup.u.sot)
?> ?=([@ @ @ ~] t.pax)
%^ mo-boot i.t.t.t.pax
?:((~(has by bum) i.t.t.t.pax) %old %new)
[(slav %p i.t.pax) i.t.t.pax [%da now]]
::
%new
?> ?=([%f %made *] sih)
?> ?=([@ @ @ ~] t.pax)
(mo-boom i.t.pax [(slav %p i.t.t.pax) i.t.t.t.pax] +>.sih)
?> ?=([@ @ @ @ ~] t.pax)
(mo-boom i.t.pax (mo-chew t.t.pax) +>.sih)
::
%old :: reload old
?> ?=([%f %made *] sih)
?> ?=([@ @ @ ~] t.pax)
(mo-boon i.t.pax [(slav %p i.t.t.pax) i.t.t.t.pax] +>.sih)
?> ?=([@ @ @ @ ~] t.pax)
(mo-boon i.t.pax (mo-chew t.t.pax) +>.sih)
::
%pel :: translated peer
?> ?=([@ @ ~] t.pax)
=+ :* mar=i.t.pax
dap=i.t.t.pax
==
?: ?=([%f %made *] sih)
?- -.q.+.sih
%tabl ~|(%made-tabl !!)
%& (mo-give %unto %diff p.q.+>.sih)
%| =. p.q.+>.sih (turn p.q.+>.sih |=(a=tank rose/[~ "! " ~]^[a]~))
~> %slog.`%*(. >[%wh %y]< +> [>%mo-cyst-fail< (flop p.q.+>.sih)])
(mo-give %unto %quit ~) :: XX better errors pls
==
?> ?=([%g %unto *] sih)
?. ?=(%diff -.+>.sih)
(mo-give %unto +>.sih)
%+ mo-pass
[%sys pax]
[%f %exec our (mo-beak dap) ~ %cast mar %done ~ `cage`+>+.sih]
::
%red :: diff ack
?> ?=([@ @ @ ~] t.pax)
@ -321,9 +354,9 @@
num=(slav %ud i.t.t.t.pax)
==
?- -.q.+>.sih
%tabl ~|(%made-tabl !!)
%| (mo-give %mack `p.q.+>.sih) :: XX should crash
%& ?> ?=(@ p.p.q.+>.sih)
=. +>.$ (mo-give %mack ~) :: XX pump should ack
%& =. +>.$ (mo-give %mack ~) :: XX pump should ack
(mo-give(hen (mo-ball him num)) %unto %diff `cage`p.q.+>.sih)
==
::
@ -335,9 +368,9 @@
==
?: ?=([%f %made *] sih)
?- -.q.+>.sih
%| (mo-give %mack `p.q.+>.sih) :: XX should crash
%& ?> ?=(@ p.p.q.+>.sih)
(mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke p.q.+>.sih)
%tabl ~|(%made-tabl !!)
%| (mo-give %mack `p.q.+>.sih) :: XX should crash
%& (mo-pass [%sys pax] %g %deal [him our] i.t.t.pax %poke p.q.+>.sih)
==
?: ?=([%a %woot *] sih) +>.$ :: quit ack, boring
?> ?=([%g %unto *] sih)
@ -346,12 +379,31 @@
%coup (mo-give %mack p.cuf)
%diff %+ mo-pass [%sys %red t.pax]
[%a %wont [our him] [%q %gh dap ~] [num %d p.p.cuf q.q.p.cuf]]
%doff !!
%quit %+ mo-pass [%sys pax]
[%a %wont [our him] [%q %gh dap ~] [num %x ~]]
%reap (mo-give %mack p.cuf)
==
::
%val :: inbound validate
?> ?=([@ @ ~] t.pax)
=+ [him=(slav %p i.t.pax) dap=i.t.t.pax]
?> ?=([%f %made *] sih)
?- -.q.+>.sih
%tabl !!
%| (mo-give %unto %coup `p.q.+>.sih) :: XX invalid, crash
%& (mo-clip dap `prey`[%high ~ him] %poke p.q.sih)
==
::
%way :: outbound request
?: ?=([%a %went *] sih) :: XX AWFUL
~& %way-went-bug
?> ?=([@ ~] t.pax)
%- mo-awed
:* p.+>.sih
(?(%peer %poke %pull) i.t.pax)
~
==
?> ?=([%a %woot *] sih)
?> ?=([@ ~] t.pax)
%- mo-awed
@ -364,7 +416,7 @@
++ mo-cook :: take in /use
|= [pax=path hin=(hypo sign-arvo)]
^+ +>
?. ?=([@ @ ?(%inn %out) *] pax)
?. ?=([@ @ ?(%inn %out %cay) *] pax)
~& [%mo-cook-bad-pax pax]
!!
=+ dap=`@tas`i.pax
@ -372,11 +424,43 @@
=+ pap=(ap-abed:ap dap pry)
=+ vax=(slot 3 `vase`hin)
?- i.t.t.pax
%inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin))
%out ?. ?=([%g %unto *] q.hin)
%inn ap-abet:(ap-pour:pap t.t.t.pax (slot 3 `vase`hin))
%cay ?. ?=([%e %sigh *] q.hin)
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
ap-abet:(ap-purr:pap +<.q.hin t.t.t.pax +>.q.hin)
::
%out ?: ?=([%f %made *] q.hin)
?- -.q.+>.q.hin
%tabl ~|(%made-tabl !!)
%& ap-abet:(ap-pout:pap t.t.t.pax %diff +.q.+>.q.hin)
%| =+ why=p.q.+>.q.hin
=. why (turn why |=(a=tank rose/[~ "! " ~]^[a]~))
~> %slog.`%*(. >[%wh %y]< +> [>%mo-cook-fail< (flop why)])
~& [him=q.q.pry our=our pax=pax]
::
:: here we should crash because the right thing
:: for the client to do is to upgrade so that it
:: understands the server's mark, thus allowing
:: the message to proceed. but ames is not quite
:: ready for promiscuous crashes, so instead we
:: send a pull outward and a quit downward.
:: or not... outgoing dap (XXX) is not in the path.
:: =. +>.$ ap-abet:(ap-pout:pap t.t.t.pax %quit ~)
:: %+ mo-pass
:: [%use pax]
:: [%g %deal [q.q.pry our] XXX %pull ~]
!!
==
?. ?=([%g %unto *] q.hin)
~& [%mo-cook-weird q.hin]
~& [%mo-cook-weird-path pax]
+>.$
?: ?=(%doff +>-.q.hin)
%+ mo-pass
[%use pax]
[%f %exec our byk.pap ~ %vale p.+>+.q.hin our q.+>+.q.hin]
ap-abet:(ap-pout:pap t.t.t.pax +>.q.hin)
==
::
@ -385,21 +469,35 @@
^+ +>
?. (~(has by bum) dap) +>
=+ suf=(~(get by wub) dap)
=+ neh=hen
?~ suf +>.$
|- ^+ +>.^$
?: =(~ kys.u.suf)
+>.^$(hen neh, wub (~(del by wub) dap))
+>.^$(wub (~(del by wub) dap))
=^ lep kys.u.suf [p q]:~(get to kys.u.suf)
:: ~& [%mo-claw-play dap r.lep]
$(+>.^$ ap-abet:(ap-club:(ap-abed:ap(hen p.lep) dap q.lep) r.lep))
$(moz :_(moz [p.lep %slip %g %deal [q.q.q.lep our] dap r.lep]))
:: $(+>.^$ (mo-clip(hen p.lep) dap q.lep r.lep))
::
++ mo-beak :: build beak
|= dap=dude
=- ?.(=(p our) - -(r [%da now])) :: soft dependencies
^- beak
:: =+ pup=pup:(~(got by bum) dap)
:: [p.pup q.pup [%da now]] :: XX this is wrong; save the build case
[our %home %da now] :: XX really wrong
byk:(~(got by bum) dap)
::
++ mo-clip :: apply club
|= [dap=dude pry=prey cub=club]
?: ?=(%puff -.cub)
%+ mo-pass
[%sys %val (scot %p q.q.pry) dap ~]
[%f %exec our (mo-beak dap) ~ %vale p.cub our q.cub]
?: ?=(%punk -.cub)
%+ mo-pass
[%sys %val (scot %p q.q.pry) dap ~]
[%f %exec our (mo-beak dap) ~ %cast p.cub %done ~ q.cub]
?: ?=(%peel -.cub)
%+ mo-pass
[%sys %pel p.cub dap ~]
[%g %deal [q.q.pry our] dap %peer q.cub]
ap-abet:(ap-club:(ap-abed:ap dap pry) cub)
::
++ mo-club :: local action
|= [dap=dude pry=prey cub=club]
@ -408,7 +506,7 @@
:: ~& [%mo-club-qeu dap cub]
=+ syf=(fall (~(get by wub) dap) *sofa)
+>.$(wub (~(put by wub) dap syf(kys (~(put to kys.syf) [hen pry cub]))))
ap-abet:(ap-club:(ap-abed:ap dap pry) cub)
(mo-clip dap pry cub)
::
++ mo-gawk :: ames forward
|= [him=@p dap=dude num=@ud rok=rook]
@ -417,21 +515,19 @@
[%sys %req (scot %p him) dap (scot %ud num) ~]
^- note-arvo
?- -.rok
%m [%f %exec our (mo-beak dap) ~ %vale p.rok our q.rok]
:: %m [%f %exec our (mo-beak dap) ~ %vale p.rok our q.rok]
%m [%g %deal [him our] dap %puff p.rok q.rok]
%s [%g %deal [him our] dap %peer p.rok]
%u [%g %deal [him our] dap %pull ~]
==
::
++ mo-gawd :: ames backward
|= [him=@p dap=dude num=@ud ron=roon]
?- -.ron
%d
%+ mo-pass
[%sys %rep (scot %p him) dap (scot %ud num) ~]
[%f %exec our (mo-beak dap) ~ %vale p.ron our q.ron]
::
%x =. +> (mo-give %mack ~) :: XX should crash
(mo-give(hen (mo-ball him num)) %unto %quit ~)
=. +> (mo-give %mack ~)
=. hen (mo-ball him num)
?- -.ron
%d (mo-give %unto %doff p.ron q.ron)
%x (mo-give %unto %quit ~)
==
::
++ ap :: agent engine
@ -504,6 +600,7 @@
%pass
:+ %pass `path`[%use dap p.q.cov]
?- -.q.q.cov
%hiss `note-arvo`[%e %hiss p.q.q.cov q.q.q.cov]
%send `note-arvo`[%g %deal [our p.q.q.cov] q.q.q.cov]
%meta `note-arvo`[`@tas`p.q.q.cov %meta `vase`q.q.q.cov]
==
@ -515,7 +612,7 @@
++ ap-call :: call into server
|= [cog=term arg=vase]
^- [(unit tang) _+>]
=. +> ap-hide
=. +> ap-bowl
=+ arm=(ap-farm cog)
?: ?=(%| -.arm) [`p.arm +>.$]
=+ zem=(ap-slam cog p.arm arg)
@ -526,8 +623,11 @@
|= cub=club
^+ +>
?- -.cub
%peel !!
%poke (ap-poke +.cub)
%peer (ap-peer +.cub)
%puff !!
%punk !!
%pull ap-pull
%pump ap-fall
==
@ -538,12 +638,12 @@
=+ cug=(ap-find [%diff p.cag +.pax])
?~ cug
%. [| her +.pax]
ap-pump:(ap-lame %diff (ap-suck "diff: no {<`path`[p.cag pax]>}"))
ap-pump:(ap-lame %diff (ap-suck "diff: no {<`path`[p.cag +.pax]>}"))
=+ ^= arg ^- vase
%- slop
?: =(0 p.u.cug)
[!>([`@ud`ost `@p`q.q.pry `path`+.pax]) !>(cag)]
[!>([`@ud`ost `@p`q.q.pry (slag (dec p.u.cug) `path`+.pax)]) q.cag]
[!>(`path`+.pax) !>(cag)]
[!>((slag (dec p.u.cug) `path`+.pax)) q.cag]
=^ cam +>.$ (ap-call q.u.cug arg)
?^ cam
(ap-pump:(ap-lame q.u.cug u.cam) | her pax)
@ -610,19 +710,23 @@
^+ +>
+>(zip :_(zip [ost %give cit]))
::
++ ap-hide :: set up hide
++ ap-bowl :: set up bowl
%_ .
+12.q.hav
^- hide
:* :* our
dap
~
==
~
sup.ged
pus.ged
tyc
==
^- bowl
:* :* our :: host
q.q.pry :: guest
dap :: agent
== ::
:* wex=~ :: outgoing
sup=sup.ged :: incoming
== ::
:* ost=ost :: cause
act=act.tyc :: tick
eny=eny.tyc :: nonce
now=lat.tyc :: time
byk=byk :: source
== == ::
==
::
++ ap-hype :: hyphenate
@ -641,6 +745,7 @@
?+ +<.q.vax
(ap-move-pass -.q.vax +<.q.vax cav)
%diff (ap-move-diff -.q.vax cav)
%hiss (ap-move-hiss -.q.vax cav)
%peer (ap-move-peer -.q.vax cav)
%pull (ap-move-pull -.q.vax cav)
%poke (ap-move-poke -.q.vax cav)
@ -662,6 +767,21 @@
[%| (ap-suck "move: improper diff")]
[%& sto %give %diff `cage`[-.q.vax (slot 3 (spec vax))]]
::
++ ap-move-hiss :: pass %hiss
|= [sto=bone vax=vase]
^- (each cove tang)
?. &(?=([p=* q=@ q=^] q.vax) ((sane %tas) q.q.vax))
[%| (ap-suck "move: malformed hiss ask.[%hiss path mark cage]")]
=+ gaw=(slot 7 vax)
?. &(?=([p=@ q=^] q.gaw) ((sane %tas) p.q.gaw))
[%| (ap-suck "move: malformed cage")]
=+ pux=((soft path) p.q.vax)
?. &(?=(^ pux) (levy u.pux (sane %ta)))
[%| (ap-suck "move: malformed path")]
:^ %& sto %pass
:- [(scot %p q.q.pry) %cay u.pux]
[%hiss q.q.vax [p.q.gaw (slot 3 (spec gaw))]]
::
++ ap-move-mess :: extract path, target
|= vax=vase
^- (each (trel path ship term) tang)
@ -774,7 +894,7 @@
=. zip ~
=^ cam +>.$
%+ ap-call q.u.cug
!>([[`@ud`ost `@p`q.q.pry] `path`(slag p.u.cug pax)])
!>(`path`(slag p.u.cug pax))
=. zip (weld zip `(list cove)`[[ost %give %reap cam] old])
?^(cam ap-pule +>.$)
::
@ -782,7 +902,6 @@
|= pax=path
%_ +>.$
sup.ged (~(put by sup.ged) ost [q.q.pry pax])
pus.ged (~(put ju pus.ged) pax ost)
==
::
++ ap-poke :: apply %poke
@ -794,8 +913,6 @@
:: ~& [%ap-poke dap p.cag cug]
=^ tur +>.$
%+ ap-call q.u.cug
%+ slop
!>([`@ud`ost `@p`q.q.pry])
?. =(0 p.u.cug) q.cag
(slop (ap-term %tas p.cag) q.cag)
(ap-give %coup tur)
@ -805,13 +922,12 @@
^+ +>
=+ cug=(ap-find /lame)
?~ cug
~> %slog.
:- ~
rose/[" " "[" "]"]^[>%ap-lame< >wut< why]
=. why [>%ap-lame dap wut< (turn why |=(a=tank rose/[~ "! " ~]^[a]~))]
~> %slog.`%*(. >[%wh %y]< +> (flop why))
+>.$
=^ cam +>.$
%+ ap-call q.u.cug
!>([[`@ud`ost `@p`q.q.pry] wut why])
!>([wut why])
?^ cam
~&([%ap-lame-lame u.cam] +>.$)
+>.$
@ -827,19 +943,36 @@
=^ cam +>.$
%+ ap-call q.u.cug
%+ slop
!>([`@ud`ost `@p`q.q.pry `path`(slag p.u.cug pax)])
!>(`path`(slag p.u.cug pax))
(slot 3 vax)
?^ cam (ap-lame -.q.vax u.cam)
+>.$
::
++ ap-purr :: unwrap take
|= [wha=term pax=path cag=cage]
^+ +>
=. q.cag (spec q.cag)
=+ cug=(ap-find [wha p.cag pax])
?~ cug
(ap-lame wha (ap-suck "{(trip wha)}: no {<`path`[p.cag pax]>}"))
=+ ^= arg ^- vase
%- slop
?: =(0 p.u.cug)
[!>(`path`pax) !>(cag)]
[!>((slag (dec p.u.cug) `path`pax)) q.cag]
=^ cam +>.$ (ap-call q.u.cug arg)
?^ cam (ap-lame q.u.cug u.cam)
+>.$
::
++ ap-pout :: specific take
|= [pax=path cuf=cuft]
^+ +>
?- -.cuf
%coup (ap-punk q.q.pry %coup +.pax `!>(p.cuf))
%coup (ap-take q.q.pry %coup +.pax `!>(p.cuf))
%diff (ap-diff q.q.pry pax p.cuf)
%quit (ap-punk q.q.pry %quit +.pax ~)
%reap (ap-punk q.q.pry %reap +.pax `!>(p.cuf))
%doff !!
%quit (ap-take q.q.pry %quit +.pax ~)
%reap (ap-take q.q.pry %reap +.pax `!>(p.cuf))
==
::
++ ap-prep :: install
@ -863,8 +996,6 @@
`+>.$(+13.q.hav +13.q.u.vux)
=^ tur +>.$
%+ ap-call %prep
%+ slop
!>([`@ud`ost `@p`q.q.pry])
?~(vux !>(~) (slop !>(~) (slot 13 u.vux)))
?~(tur `+>.$ :_(+>.$ `u.tur))
::
@ -873,7 +1004,6 @@
?~ wim +
%_ +
sup.ged (~(del by sup.ged) ost)
pus.ged (~(del ju pus.ged) q.u.wim ost)
qel.ged (~(del by qel.ged) ost)
==
::
@ -881,14 +1011,13 @@
=+ wim=(~(get by sup.ged) ost)
?~ wim ~&(%ap-pull-none +)
=: sup.ged (~(del by sup.ged) ost)
pus.ged (~(del ju pus.ged) q.u.wim ost)
qel.ged (~(del by qel.ged) ost)
==
=+ cug=(ap-find %pull q.u.wim)
?~ cug +>
=^ cam +>
%+ ap-call q.u.cug
!>([[`@ud`ost `@p`q.q.pry] (slag p.u.cug q.u.wim)])
!>((slag p.u.cug q.u.wim))
?^ cam (ap-lame q.u.cug u.cam)
+>+
::
@ -896,16 +1025,16 @@
~& [%ap-kill dap ost]
(ap-give:ap-pull %quit ~)
::
++ ap-punk :: non-diff gall take
++ ap-take :: non-diff gall take
|= [her=ship cog=term pax=path vux=(unit vase)]
^+ +>
=+ cug=(ap-find cog pax)
?~ cug
~& [%ap-punk-none cog pax]
~& [%ap-take-none cog pax]
+>.$
=^ cam +>.$
%+ ap-call q.u.cug
=+ den=!>([`@ud`ost `@p`q.q.pry (slag p.u.cug pax)])
=+ den=!>((slag p.u.cug pax))
?~(vux den (slop den u.vux))
?^ cam (ap-lame q.u.cug u.cam)
+>.$
@ -947,10 +1076,9 @@
|= [cog=term gat=vase arg=vase]
^- (each vase tang)
=+ wiz=(mule |.((slit p.gat p.arg)))
?: ?=(%| -.wiz)
~& %ap-slam-mismatch
~> %slog.[0 ~(duck ut p.arg)]
~> %slog.[0 ~(duck ut (~(peek ut p.gat) %free 6))]
?: ?=(%| -.wiz)
%- =+ sam=(~(peek ut p.gat) %free 6)
(slog 0 >%ap-slam-mismatch< ~(duck ut p.arg) ~(duck ut sam) ~)
[%| (ap-suck "call: {<cog>}: type mismatch")]
=+ ton=(mong [q.gat q.arg] ap-sled)
?- -.ton
@ -980,14 +1108,14 @@
%deal `%g
%exec `%f
%flog `%d
%font `%c
%info `%c
%lynx `%c
%merg `%c
%plug `%c
%mont `%c
%ogre `%c
%them `%e
%wait `%t
%want `%a
%warp `%c
==
--
--
@ -1010,7 +1138,7 @@
(mo-come:(mo-abed:mo q.p.q.hic hen) p.p.q.hic q.q.hic)
::
%init
~& [%gall-init p.q.hic]
:: ~& [%gall-init p.q.hic]
[~ ..^$(pol.all (~(put by pol.all) p.q.hic [hen ~ ~ ~]))]
::
%rote

232
base/arvo/hoon.hoon
View File

@ -28,6 +28,7 @@
++ ache |*([a=$+(* *) b=$+(* *)] $%([| p=b] [& p=a])) :: each, b default
++ axis ,@ :: tree address
++ also ,[p=term q=wing r=type] :: alias
++ bank (list ,@cF) :: UTF-32 string
++ base ?([%atom p=odor] %noun %cell %bean %null) :: axils, @ * ^ ? ~
++ bean ,? :: 0=&=yes, 1=|=no
++ beer $|(@ [~ p=twig]) :: simple embed
@ -61,7 +62,7 @@
[%many p=(list coin)] ::
== ::
++ cord ,@t :: text atom (UTF-8)
++ dock (pair ,@p term) :: message target
++ dock (pair ,@p term) :: message target
++ date ,[[a=? y=@ud] m=@ud t=tarp] :: parsed date
++ dime ,[p=@ta q=@] ::
++ each |*([a=$+(* *) b=$+(* *)] $%([& p=a] [| p=b])) :: either a or b
@ -154,10 +155,10 @@
++ rule |=(tub=nail `edge`[p.tub ~ ~ tub]) :: parsing rule
++ span ,@ta :: text-atom (ASCII)
++ spot ,[p=path q=pint] :: range in file
++ tang (list tank) :: general error
++ tang (list tank) :: bottom-first error
++ tank $% [%leaf p=tape] :: printing formats
$: %palm :: backstep list
p=[p=tape q=tape r=tape s=tape] ::
p=[p=tape q=tape r=tape s=tape] ::
q=(list tank) ::
== ::
$: %rose :: flat list
@ -256,7 +257,7 @@
[%dtwt p=twig] :: nock 3 cell test
:: :::::: prettyprinting
[%hxgl p=tusk] :: prettyprint tape
[%hxgr p=tusk] :: prettyprint tank
[%hxgr p=tusk] :: prettyprint tank
:: :::::: type conversion
[%ktbr p=twig] :: %gold core to %iron
[%ktdt p=twig q=twig] :: cast q to type (p q)
@ -307,7 +308,7 @@
[%wthz p=tiki q=tine] :: tiki %wthp
[%wtcl p=twig q=twig r=twig] :: if p, then q, else r
[%wtdt p=twig q=twig r=twig] :: unless, ?:(p r q)
[%wtkt p=wing q=twig r=twig] :: if p is a cell
[%wtkt p=wing q=twig r=twig] :: if p is a cell
[%wtkz p=tiki q=twig r=twig] :: tiki %wtkt
[%wtgl p=twig q=twig] :: assert |, ?:(p !! q)
[%wtgr p=twig q=twig] :: assert &, ?:(p q !!)
@ -399,7 +400,7 @@
++ unce |* a=_,* :: change part
$% [%& p=@ud] :: skip[copy]
[%| p=(list a) q=(list a)] :: p -> q[chunk]
== ::
== ::
++ unit |* a=_,* :: maybe
$|(~ [~ u=a]) ::
++ upas :: tree change (%d)
@ -526,10 +527,10 @@
~/ %lth
|= [a=@ b=@]
^- ?
?& !=(a b)
|-
?| =(0 a)
?& !=(0 b)
?& !=(a b)
|-
?| =(0 a)
?& !=(0 b)
$(a (dec a), b (dec b))
== == ==
::
@ -691,7 +692,7 @@
^- @
=+ b=0
|-
?~ a b
?~ a b
$(a t.a, b +(b))
::
++ levy
@ -941,9 +942,9 @@
a (rsh 0 1 a)
b (rsh 0 1 b)
c +(c)
d %+ add d
%^ lsh 0 c
?& =(0 (end 0 1 a))
d %+ add d
%^ lsh 0 c
?& =(0 (end 0 1 a))
=(0 (end 0 1 b))
==
==
@ -958,9 +959,9 @@
a (rsh 0 1 a)
b (rsh 0 1 b)
c +(c)
d %+ add d
%^ lsh 0 c
?| =(0 (end 0 1 a))
d %+ add d
%^ lsh 0 c
?| =(0 (end 0 1 a))
=(0 (end 0 1 b))
==
==
@ -1057,7 +1058,7 @@
|= [syd=@ key=@]
?> (lte (met 5 syd) 1)
=+ ^= row
|= [a=@ b=@]
|= [a=@ b=@]
(con (end 5 1 (lsh 0 a b)) (rsh 0 (sub 32 a) b))
=+ mow=|=([a=@ b=@] (end 5 1 (mul a b)))
=+ len=(met 5 key)
@ -1073,7 +1074,7 @@
?: =(inx len) goc
=+ kop=(cut 5 [inx 1] key)
=. kop (mow kop 0xcc9e.2d51)
=. kop (row 15 kop)
=. kop (row 15 kop)
=. kop (mow kop 0x1b87.3593)
=. goc (mix kop goc)
=. goc (row 13 goc)
@ -1149,20 +1150,20 @@
/remlysfynwerrycsugnysnyllyndyndemluxfedsedbecmun\
/lyrtesmudnytbyrsenwegfyrmurtelreptegpecnelnevfes'
|%
++ ind ~/ %ind :: parse prefix
|= a=@tas
=+ b=0
|- ^- (unit ,@)
?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
++ ins ~/ %ins :: parse suffix
++ ins ~/ %ins :: parse prefix
|= a=@tas
=+ b=0
|- ^- (unit ,@)
?:(=(256 b) ~ ?:(=(a (tos b)) [~ b] $(b +(b))))
++ tod ~/ %tod :: fetch prefix
|=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
++ tos ~/ %tos :: fetch suffix
++ ind ~/ %ind :: parse suffix
|= a=@tas
=+ b=0
|- ^- (unit ,@)
?:(=(256 b) ~ ?:(=(a (tod b)) [~ b] $(b +(b))))
++ tos ~/ %tos :: fetch prefix
|=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] sis)))
++ tod ~/ %tod :: fetch suffix
|=(a=@ ?>((lth a 256) (cut 3 [(mul 3 a) 3] dex)))
--
::
++ fa :: base58check
@ -1181,7 +1182,7 @@
::
++ pad |=(a=@ =+(b=(met 3 a) ?:((gte b 21) 0 (sub 21 b))))
++ enc |=(a=@ux `@ux`(mix (lsh 3 4 a) (tok a)))
++ den
++ den
|= a=@ux ^- (unit ,@ux)
=+ b=(rsh 3 4 a)
?. =((tok b) (end 3 4 a))
@ -1264,6 +1265,17 @@
++ sum |=([b=@ c=@] (sit (add b c))) :: wrapping add
++ sit |=(b=@ (end a 1 b)) :: enforce modulo
--
::
++ stat :: positive counter
!:
|* a=$+(* *)
|= (trel ,? a (map a ,@ud))
^+ r
=+ (~(get by r) q)
?: p
(~(put by r) q ?~(- 1 +(u.-)))
?> ?=(^ -)
?:(=(0 u.-) (~(del by r) q) (~(put by r) q (dec u.-)))
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 2cG, floating point ::
::
@ -1272,18 +1284,18 @@
=+ s=(sea:rd red)
=+ negexp==(1 (mod e.s 2))
[s=(sig:rd red) h=(hol:rd red) f=(fac:rd red) e=(err:rd red) n=negexp]
++ rlyh |=(reh=@rh ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlyq |=(req=@rq ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlys |=(res=@rs ~|(%real-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlyh |=(reh=@rh ~|(%realh-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlyq |=(req=@rq ~|(%realq-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ rlys |=(res=@rs ~|(%reals-nyet ^-([s=? h=@ f=@ e=(unit tape) n=?] !!)))
++ ryld |= v=[syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ^- @rd
?: &(=(hol.v 0) =(zer.v 0) =(fac.v 0))
(bit:rd (szer:vl:fl 1.023 52 syn.v))
?~ exp.v
(bit:rd (cof:fl 52 1.023 v))
(ipow:rd u.exp.v (bit:rd (cof:fl 52 1.023 v)))
++ rylh |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rh !!)))
++ rylq |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rq !!)))
++ ryls |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%real-nyet ^-(@rs !!)))
++ rylh |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%realh-nyet ^-(@rh !!)))
++ rylq |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%realq-nyet ^-(@rq !!)))
++ ryls |=([syn=? hol=@ zer=@ fac=@ exp=(unit ,@)] ~|(%reals-nyet ^-(@rs !!)))
:: Floating point operations for general floating points.
:: [s=sign, e=unbiased exponent, f=fraction a=ari]
@ -1403,7 +1415,7 @@
=+ n=(^sub (met 0 a) (^add p 1))
=+ r=(end 0 n a)
(rne p a r n)
::
::
:: the real rnd
++ rne |= [p=@u a=@u r=@u n=@u] ^- @u
=+ b=(rsh 0 n a)
@ -1449,14 +1461,13 @@
++ inf |= [b=@u n=[s=? e=@s a=@u]]
&(=(e.n (^mul 2 +(b))) =(0 (ira a.n)))
++ gar |= [b=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
++ gar |= [b=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
^- (unit ,[s=? e=@s a=@u])
?: (snan b n) ~|(%floating-nan !!)
?: (snan b n) ~|(%floating-nan !!)
?: (nan b n) [~ n]
?: (nan b m) [~ m]
~
++ pro |= [b=@u p=@u n=[s=? e=@s a=@u]]
^- [s=? e=@s a=@u]
=+ maxexp=`@s`(^mul 2 +(b))
@ -1466,7 +1477,6 @@
?: &(=(1 (mod e.n 2)) (^gte e.n minexp))
(szer:vl:fl b p s.n) :: flush denorms
n
++ err |= [b=@u p=@u n=[s=? e=@s a=@u]]
^- (unit tape)
?: (snan b n) [~ "snan"]
@ -1476,7 +1486,7 @@
~
--
::::::::::::
++ add |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
++ add |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
^- [s=? e=@s a=@u]
=+ g=(gar:te:fl b n m)
?: ?=(^ g)
@ -1499,7 +1509,7 @@
=+ e2=(sum:si (sun:si dif2) e.n)
(pro:te:fl b p [s=|(s.n s.m) e=e2 a=(lia p a3)])
++ sub |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
++ sub |= [b=@u p=@u n=[s=? e=@s a=@u] m=[s=? e=@s a=@u]]
^- [s=? e=@s a=@u]
=+ g=(gar:te:fl b n m)
?: ?=(^ g)
@ -1663,7 +1673,7 @@
++ bex |= a=@s ^- @rd
(bit [s=%.y e=a a=(ari:fl mlen 0)])
++ ipow |= [exp=@s n=@rd]
^- @rd
?: =(0 (mod exp 2))
@ -1822,6 +1832,9 @@
|* b=_+<+.a
(a b c)
::
++ gulf :: range list
|=([a=@ b=@] `(list ,@)`?:(=(a b) ~ [a $(a +(a))]))
::
++ hard :: force coerce to type
|* han=$+(* *)
|= fud=* ^- han
@ -1834,7 +1847,19 @@
|= fud=* ^- (unit han)
=+ gol=(han fud)
?.(=(gol fud) ~ [~ gol])
::
++ slog :: deify printf
|= [a=?(~ @u) b=tang] ^+ same :: .= ~&(%a 1)
?~(b same ~>(%slog.[a i.b] $(b t.b))) :: ((slog `~[>%a<]) 1)
::
++ mean |=(a=tang (fear (flop a) |.(!!))) :: deify stack trace
++ fear :: insert user mean
|* [a=tang _|?(**)]
^+ (+<+)
=> .(a `tang`a)
?~ a (+<+)
~> %mean.|.(i.a)
$(a t.a)
:::::::::::::::::::::::::::::::::::::::::::::::::::::: ::
:::: chapter 2d, containers ::::
:: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
@ -2024,6 +2049,14 @@
(~(del by a) b)
(~(put by a) b e)
::
+- gas :: concatenate
|* b=(list ,[p=* q=*])
=> .(b `(list ,_?>(?=([[* ^] ^] a) [p=p q=n.q]:n.a))`b)
|- ^+ a
?~ b
a
$(b t.b, a (put(+< a) p.i.b q.i.b))
::
+- get :: gets set by key
|* b=*
=+ c=(~(get by a) b)
@ -2251,7 +2284,7 @@
?~(b a $(b t.b, a (put(+< a) i.b)))
::
+- get :: head-tail pair
|- ^+ [p=?>(?=(^ a) n.a) q=a]
|- ^+ ?>(?=(^ a) [p=n.a q=*(qeu ,_n.a)])
?~ a
!!
?~ r.a
@ -3439,7 +3472,7 @@
::
%r
?+ hay (z-co q.p.lot)
%d
%d
=+ r=(rlyd q.p.lot)
?~ e.r
['.' '~' (r-co r)]
@ -3486,7 +3519,7 @@
=> .(rex ['.' (t-co ((d-co 1) der) ne)])
=> .(rex ((d-co 1) nub))
?:(syn rex ['-' rex])
++ t-co |= [a=tape n=?] ^- tape
++ t-co |= [a=tape n=?] ^- tape
?: n a
?~ a ~|(%empty-frac !!) t.a
::
@ -3654,22 +3687,22 @@
;~ plug
;~(pose (cold | hep) (easy &))
;~(plug dim:ag ;~(pose ;~(pfix dot ;~(plug zer dim:ag)) (easy [0 0])))
;~ pose
;~ pfix
(just 'e')
;~ pose
;~ pfix
(just 'e')
(cook some ;~(plug ;~(pose (cold | hep) (easy &)) dim:ag))
==
(easy ~)
==
(easy ~)
==
==
;~ pose
(stag %rh (cook rylh ;~(pfix ;~(plug sig sig) voy)))
(stag %rq (cook rylq ;~(pfix ;~(plug sig sig sig) voy)))
(stag %rd (cook ryld ;~(pfix sig voy)))
(stag %rs (cook ryls voy))
:: (stag %rs (cook ryls voy))
==
++ royl-cell
|= [a=? b=[c=@ d=@ e=@] f=(unit ,[h=? i=@])]
|= [a=? b=[c=@ d=@ e=@] f=(unit ,[h=? i=@])]
^- [? @ @ @ (unit ,@s)]
?~ f
[a c.b d.b e.b ~]
@ -3990,7 +4023,7 @@
[10 [b=* c=*] d=*]
=+ ben=$(fol c.fol)
?. ?=(%0 -.ben) ben
?: ?=(?(%hunk %lose %mean %spot) b.fol)
?: ?=(?(%hunk %hand %lose %mean %spot) b.fol)
$(fol d.fol, tax [[b.fol p.ben] tax])
$(fol d.fol)
::
@ -4031,6 +4064,7 @@
?+ -.i.p.ton rex
%hunk [(tank +.i.p.ton) rex]
%lose [[%leaf (rip 3 (,@ +.i.p.ton))] rex]
%hand :_(rex [%leaf (scow %p (mug +.i.p.ton))])
%mean :_ rex
?@ +.i.p.ton [%leaf (rip 3 (,@ +.i.p.ton))]
=+ mac=(mack +.i.p.ton +<.i.p.ton)
@ -4121,7 +4155,7 @@
|* [hel=(list) hev=(list)]
|- ^+ hev
=+ ^= sev
=+ [inx=0 sev=*(map ,@t (list ,@ud))]
=+ [inx=0 sev=*(map ,_i.-.hev (list ,@ud))]
|- ^+ sev
?~ hev sev
=+ guy=(~(get by sev) i.hev)
@ -4974,7 +5008,7 @@
=+ zd=(qr ~[&16.y &13.y &14.y &15.y])
^- (list ,@) :~
&1.za &2.za &3.za &4.za
&4.zb &1.zb &2.zb &3.zb
&4.zb &1.zb &2.zb &3.zb
&3.zc &4.zc &1.zc &2.zc
&2.zd &3.zd &4.zd &1.zd
==
@ -5099,7 +5133,7 @@
?: (gth j l) t
=+ u=(add s (lsh 3 sl (rep 3 (flop (rpp 3 4 j)))))
=+ f=0 =. f |- ^- @
?: (gth k c) f
?: (gth k c) f
=+ q=(hml p pl u ?:(=(k 1) (add sl 4) h))
$(u q, f (mix f q), k +(k))
$(t (add t (lsh 3 (mul (dec j) h) f)), j +(j))
@ -5637,7 +5671,7 @@
:: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 2fA, miscellaneous funs ::
:: ::
++ bull :: make %bull type
++ bull :: make %bull type
|= [bid=twin der=type]
^- type
?:(|(=(%void der) =(%void s.bid)) %void [%bull bid der])
@ -5672,7 +5706,7 @@
[%face cog der]
::
++ bool ^-(type [%fork [%cube 0 %atom %f] [%cube 1 %atom %f]]) :: -:!>(*?)
++ flay
++ flay
~/ %flay
|= pok=port
^- [p=axis q=type]
@ -5911,7 +5945,7 @@
++ seed :: hoon/hoon core vase
^- vase
!!
:: ~+ :: trimmed
:: ~+ :: trimmed
:: !;(*type ..seed)
::
++ seem |=(toy=typo `type`toy) :: promote typo
@ -5981,7 +6015,7 @@
~
`[(~(peek ut p.vax) %free axe) .*(q.vax [0 axe])]
::
++ slab
++ slab
|= [cog=@tas typ=type]
!=(~ q:(~(fino ut typ) 0 %free cog))
::
@ -6017,7 +6051,7 @@
|= [sut=type ref=type]
^- [? worm]
?: (~(has in nes) [sut ref]) [& +>+<]
?. (~(nest ut sut) | ref)
?. (~(nest ut sut) | ref)
:: ~& %nest-failed
[| +>+<]
[& +>+<(nes (~(put in nes) [sut ref]))]
@ -6070,7 +6104,7 @@
++ spec :: specialize vase
|= vax=vase
^- [vase worm]
=+ ^= gen ^- twig
=+ ^= gen ^- twig
?@ q.vax [%wtts [%axil [%atom %$]] [%$ 1]~]
?@ -.q.vax [%wtts [%leaf %tas -.q.vax] [%$ 2]~]
[%wtts [%axil %cell] [%$ 1]~]
@ -6325,7 +6359,7 @@
[%cnzz [@ ~]] i.p.gen
[%zpcb *] $(gen q.gen)
[@ *] =+(neg=open ?:(=(gen neg) [%0 ~] $(gen neg)))
[^ *] =+ toe=[$(gen p.gen) $(gen q.gen)]
[^ *] =+ toe=[$(gen p.gen) $(gen q.gen)]
?:(=(toe [[%0 ~] [%0 ~]]) [%0 ~] [%2 toe])
==
::
@ -6376,7 +6410,7 @@
[i.p.gen $(p.gen t.p.gen)]
::
[%cncb *] [%ktls [%cnzz p.gen] %cnts p.gen q.gen]
[%cncl *]
[%cncl *]
=+ rem=[%cnsg [%$ ~] p.gen q.gen]
?. ?=([%zpcb ^ %cnzz @ ~] p.gen) rem
=> .(p.gen `[@ ^ @ p=@tas ~]`p.gen)
@ -6409,7 +6443,7 @@
:- %mean
=+ fek=~(feck ap p.gen)
?^ fek [%dtzz %tas u.fek]
[%brdt [%cnhp [%cnzy %cain] [%zpgr p.gen] ~]]
[%brdt [%cnhp [%cnzy %cain] [%zpgr [%tsgr [~ 3] p.gen]] ~]]
q.gen
::
[%sgcb *] [%sggr [%mean [%brdt p.gen]] q.gen]
@ -6963,7 +6997,7 @@
%type
=+ cis=((hard tank) .*(.(sut lum) !=(duck))) :: type bypass
:^ ~ %palm
[~ ~ ~ ~]
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
%wall
@ -8426,7 +8460,7 @@
$(i.ruw t.i.ruw, cah [i.i.ruw cah])
$(i.ruw t.i.ruw, cah ~, yun [p.i.i.ruw (wod cah yun)])
::
++ posh !:
++ posh !:
|= [pre=(unit tyke) pof=(unit ,[p=@ud q=tyke])]
^- (unit (list twig))
=- ?^(- - ~&(%posh-fail -))
@ -8449,7 +8483,7 @@
^- (unit tusk)
?~ goo `~
%+ both
?^(i.goo i.goo ?~(pag ~ `u=i.pag))
?^(i.goo i.goo ?~(pag ~ `u=i.pag))
$(goo t.goo, pag ?~(pag ~ t.pag))
::
++ poor
@ -8734,7 +8768,7 @@
==
--
::
++ scat
++ scat !:
%+ knee *twig |. ~+
%- stew
^. stet ^. limo
@ -8765,6 +8799,7 @@
;~ pose
(cook |=(a=wing [%cnts a ~]) rope)
(stag %wtpm ;~(pfix pam (ifix [pel per] (most ace wide))))
;~(plug (stag %dtzz (stag %f (cold & pam))) ;~(pfix fas wide))
(stag %dtzy (stag %f (cold & pam)))
==
:- '\''
@ -8844,6 +8879,7 @@
;~ pose
(cook |=(a=wing [%cnts a ~]) rope)
(stag %wtbr ;~(pfix bar (ifix [pel per] (most ace wide))))
;~(plug (stag %dtzz (stag %f (cold | bar))) ;~(pfix fas wide))
(stag %dtzy (stag %f (cold | bar)))
==
:- '~'
@ -8875,7 +8911,7 @@
;~ pose
;~ less (jest '"""')
%+ ifix [doq doq]
%- star
%- star
;~ pose
;~(pfix bas ;~(pose bas doq kel bix:ab))
;~(less doq bas kel prn)
@ -8885,7 +8921,7 @@
::
%- inde %+ ifix
[(jest '"""\0a') (jest '\0a"""')]
%- star
%- star
;~ pose
;~(pfix bas ;~(pose bas kel bix:ab))
;~(less bas kel prn)
@ -9109,6 +9145,7 @@
%- stew
^. stet ^. limo
:~ [':' ;~(pfix col (toad expz))]
['.' ;~(pfix dot (toad |.(loaf(bug |))))]
[',' (rune com %zpcm expb)]
[';' (rune sem %zpsm expb)]
['^' ;~(pfix ket (sear prey (toad exps)))]
@ -9299,7 +9336,7 @@
%pel [~ %cnts ~(rake ap ros) p.vil]
%pat [~ %bcpt ~(rake ap ros) p.vil]
%ket [~ ros p.vil]
%tis =+ tog=~(hock ap ros)
%tis =+ tog=~(hock ap ros)
?:(=([%0 ~] tog) ~ [~ %ktts tog p.vil])
==
::
@ -9449,7 +9486,7 @@
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: profiling support; move me ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ doss
++ doss
$: mon=moan :: sample count
hit=(map term ,@ud) :: hit points
cut=(map path hump) :: cut points
@ -9490,11 +9527,11 @@
=+ nax=`(unit path)`?~(t.paz ~ `i.t.paz)
=+ hup=`hump`=+(hup=(~(get by cut.day) i.paz) ?^(hup u.hup [*moan ~ ~]))
:+ (pi-mope mot mon.hup)
?~ lax out.hup
=+ hag=(~(get by out.hup) u.lax)
?~ lax out.hup
=+ hag=(~(get by out.hup) u.lax)
(~(put by out.hup) u.lax ?~(hag 1 +(u.hag)))
?~ nax inn.hup
=+ hag=(~(get by inn.hup) u.nax)
?~ nax inn.hup
=+ hag=(~(get by inn.hup) u.nax)
(~(put by inn.hup) u.nax ?~(hag 1 +(u.hag)))
==
++ pi-mope :: add sample
@ -9595,7 +9632,6 @@
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: volume 3, Arvo models and skeleton ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
!:
~% %arvo + ~
|%
++ arch ,[p=@uvI q=(unit ,@uvI) r=(map ,@ta ,~)] :: fundamental node
@ -9618,20 +9654,6 @@
== ::
++ curd ,[p=@tas q=*] :: typeless card
++ duct (list wire) :: causal history
++ gage (pair marc vase) :: structured cage
++ from ,[ost=bone src=ship] :: forward problem
++ hide :: standard app state
$: $: our=ship :: owner/operator
app=term :: app identity
imp=path :: app instance
== ::
cub=(map span term) :: offspring
sup=(map bone (pair ship path)) :: subscription set
pus=(jug path bone) :: noitpircsbus set
$: act=@ud :: change number
eny=@uvI :: entropy
lat=@da :: date of last tick
== == ::
++ hypo |*(a=$+(* *) (pair type a)) :: type associated
++ hobo |* a=$+(* *) :: kiss wrapper
$? $% [%soft p=*] ::
@ -9676,7 +9698,6 @@
++ slad $+ [(unit (set monk)) term beam] :: undertyped
(unit (unit (cask))) ::
++ slut $+(* (unit (unit))) :: old namespace
++ then ,[ost=bone src=ship way=wire] :: backward problem
++ vile :: reflexive constants
$: typ=type :: -:!>(*type)
duc=type :: -:!>(*duct)
@ -9685,12 +9706,7 @@
== ::
++ wire path :: event pretext
::::: hacks and tools
++ pale |= [hid=hide fun=$+(sink ?)] :: filter peers
(skim (~(tap by sup.hid)) fun)
++ prix |= pax=path |= sink ^- ? :: filter gate
?~ pax & ?~ r.+< | ::
&(=(i.pax i.r.+<) $(pax t.pax, r.+< t.r.+<)) ::
++ slod
++ slod
|= sed=slad
^- slut
|= raw=*
@ -9755,7 +9771,7 @@
| [%| [%cell typ.vil p.p.hil] p.hil]
==
::
++ slur :: call gate on
++ slur :: call gate on
|= [gat=vase hil=mill]
^- (unit (pair vase worm))
=+ sam=(slot 6 gat)
@ -9777,7 +9793,7 @@
::
++ slur-pro :: profiling slur
~/ %slur-pro
|= [lal=@tas gat=vase hil=mill]
|= [lal=@tas gat=vase hil=mill]
?+ lal (slur-z gat hil)
%a (slur-a gat hil)
%b (slur-b gat hil)
@ -9847,7 +9863,7 @@
[%sick p=[p=@tas q=*]]
%- (bond |.([%| p.p.q.caq]))
=^ yav p.sew (~(spot wa p.sew) 3 caq)
%+ bind (song yav)
%+ bind (song yav)
|= [hil=mill vel=worm]
[%& [%sick hil] vel]
::
@ -9919,10 +9935,10 @@
(slid [%& duc.vil hen] (slix hil))
~| [%swim-take-vane lal]
=^ vax p.sew (~(slap wa p.sew) rig [%cnzy %take])
%^ slur-pro lal vax
%^ slur-pro lal vax
;: slid
[%& pah.vil u.pux]
[%& duc.vil hen]
[%& pah.vil u.pux]
[%& duc.vil hen]
(slix (slid [%& [%cube org %atom %tas] org] hil))
==
?~ pru
@ -9973,6 +9989,7 @@
|= hap=path ^- @tas
?+ hap !!
[@ %ames *] %a
[@ %boat *] %c
[@ %newt *] %a
[@ %sync *] %c
[@ %term *] %d
@ -10027,7 +10044,7 @@
:: =. lac |(lac ?=(?(%g %f) p.gum))
:: =. lac &(lac !?=(%b p.gum))
%+ fire
p.gum
p.gum
?- -.r.gum
%pass
~? &(!lac !=(%$ p.gum))
@ -10069,7 +10086,6 @@
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
:::::: :::::: Postface ::::::
:::::: ::::::::::::::::::::::::::::::::::::::::::::::::::::::
~& %post-start
=+ pit=`vase`!>(.) ::
=+ bud=pit :: becomes tang
=+ vil=(viol p.bud) :: cached reflexives

82
base/arvo/zuse.hoon
View File

@ -1029,8 +1029,7 @@
^- miso
=+ dir=((hard arch) .^(%cy pax))
?~ q.dir [%ins val]
=+ for=((hard mark) -:(flop pax))
[%mut [for [%atom %$] .^(%cx pax)] val]
[%mut val]
::
++ file :: simple file load
|= pax=path
@ -1048,7 +1047,7 @@
|= pax=path
^- toro
?> ?=([* * * *] pax)
[i.t.pax [%& [*cart [[t.t.t.pax [%del %$ !>(.^(%cx pax))]] ~]]]]
[i.t.pax [%& [*cart [[t.t.t.pax [%del ~]] ~]]]]
::
++ furl :: unify changes
|= [one=toro two=toro]
@ -1242,6 +1241,10 @@
=+ nex=$(tep t.tep)
?~(nex ~ [~ i.tep u.nex])
::
++ earf :: purf to tape
|= purf
(weld (earn p) ?~(q "" `tape`['#' (trip u.q)]))
::
++ earl :: localize purl
|= [who=@p pul=purl]
^- purl
@ -1301,6 +1304,8 @@
++ apat :: 2396 abs_path
%+ cook deft
(ifix [fas ;~(pose fas (easy ~))] (more fas smeg))
++ aurf :: 2396 with fragment
;~(plug auri (punt ;~(pfix hax (cook crip (star pque)))))
++ auri :: 2396 URL
%+ cook
|= a=purl
@ -1694,7 +1699,16 @@
?:(=(%lord -.p.gos) ~['[' nad ']'] ~['(' nad ')'])
==
==
++ pale :: filter peers
|= [hid=bowl fun=$+(sink ?)]
(skim (~(tap by sup.hid)) fun)
::
++ prix :: filter gate
|= pax=path |= sink ^- ?
?~ pax & ?~ r.+< |
&(=(i.pax i.r.+<) $(pax t.pax, r.+< t.r.+<))
::
++ prey |=([pax=path hid=bowl] (pale hid (prix pax))) :: prefix
++ hunt :: first of unit dates
|= [one=(unit ,@da) two=(unit ,@da)]
^- (unit ,@da)
@ -1818,12 +1832,13 @@
lys=@da :: last sent
pac=rock :: packet data
== ::
++ bitt (map bone (pair ship path)) :: incoming subs
++ blob :: fs blob
$% [%delta p=lobe q=[p=mark q=lobe] r=page] :: delta on q
[%direct p=lobe q=page] :: immediate
[%indirect p=lobe q=page r=lobe s=page] :: both
== ::
++ boat ,[(list slip) tart] :: user stage
++ boat (map (pair bone wire) (trel bean ship path)) :: outgoing subs
++ boon :: fort output
$% [%beer p=ship q=@uvG] :: gained ownership
[%cake p=sock q=soap r=coop s=duct] :: e2e message result
@ -1834,7 +1849,20 @@
[%ouzo p=lane q=rock] :: transmit packet
[%wine p=sock q=tape] :: notify user
== ::
++ bowl ,[p=(list gift) q=(unit boat)] :: app product
++ bowl :: standard app state
$: $: our=ship :: host
src=ship :: guest
dap=term :: agent
== ::
$: wex=boat :: outgoing subs
sup=bitt :: incoming subs
== ::
$: ost=bone :: opaque cause
act=@ud :: change number
eny=@uvI :: entropy
now=@da :: current time
byk=beak :: load source
== == ::
++ bray ,[p=life q=(unit life) r=ship s=@da] :: our parent us now
++ brow ,[p=@da q=@tas] :: browser version
++ buck ,[p=mace q=will] :: all security data
@ -2084,13 +2112,13 @@
++ mime ,[p=mite q=octs] :: mimetyped data
++ mite (list ,@ta) :: mime type
++ miso :: ankh delta
$% [%del p=cage] :: delete
$% [%del ~] :: delete
[%ins p=cage] :: insert
[%dif p=cage] :: mutate from diff
[%mut p=cage q=cage] :: mutate from raw
[%mut p=cage] :: mutate from raw
== ::
++ misu :: computed delta
$% [%del p=cage] :: delete
$% [%del ~] :: delete
[%ins p=cage] :: insert
[%dif p=lobe q=cage] :: mutate from diff
== ::
@ -2129,6 +2157,7 @@
++ pred ,[p=@ta q=@tas r=@ta ~] :: proto-path
++ prod ,[p=prom q=tape r=tape] :: prompt
++ prom ?(%text %pass %none) :: format type
++ purf (pair purl (unit ,@t)) :: url with fragment
++ purl ,[p=hart q=pork r=quay] :: parsed url
++ putt :: outgoing message
$: ski=snow :: sequence acked/sent
@ -2236,7 +2265,6 @@
++ step ,[p=bray q=gens r=pass] :: identity stage
++ suba ,[p=cart q=(list ,[p=path q=misu])] :: delta
++ tako ,@ :: yaki ref
++ tart $+([@da path note] bowl) :: process core
++ tick ,@ud :: process id
++ toro ,[p=@ta q=nori] :: general change
++ town :: all security state
@ -2295,26 +2323,28 @@
::
++ khan ::
$: fil=(unit (unit cage)) :: XX see khan-to-soba
dir=(map ,@ta (unit khan)) ::
dir=(unit (map ,@ta (unit khan))) ::
== ::
++ mick (list ,[path (unit mime)])
++ mode (list ,[path (unit mime)])
++ riff ,[p=desk q=(unit rave)] :: request/desist
:::: ::
++ gift-clay :: out result <-$
$% [%ergo p=@p q=@tas r=@ud s=mick] :: version update
$% [%ergo p=@tas q=mode] :: version update
[%hill p=(list ,@tas)] :: mount points
[%mass p=mass] :: memory usage
[%mere p=(each (set path) (pair term tang))] :: merge result
[%note p=@tD q=tank] :: debug message
[%ogre p=@tas] :: delete mount point
[%writ p=riot] :: response
== ::
++ kiss-clay :: in request ->$
$% [%font p=@p q=@tas r=@p s=@tas] :: set upstream
$% [%boat ~] :: pier rebooted
[%info p=@p q=@tas r=nori] :: internal edit
[%init p=@p] :: report install
[%into p=@p q=@tas r=khan] :: external edit
[%lynx p=@p q=@tas r=(unit ,?)] :: sync to unix
[%into p=@tas q=? r=mode] :: external edit
[%merg p=@p q=@tas r=@p s=@tas t=germ] :: merge desks
[%plug p=@p q=@tas r=@p s=@tas] :: unset upstream
[%mont p=@tas q=@p r=@tas s=path] :: mount to unix
[%ogre p=$|(@tas beam)] :: delete mount point
[%wart p=sock q=@tas r=path s=*] :: network request
[%warp p=sock q=riff] :: file request
[%wegh ~] :: report memory
@ -2418,6 +2448,7 @@
++ kiss-eyre :: in request ->$
$% [%born ~] :: new unix process
[%crud p=@tas q=(list tank)] :: XX rethink
[%hiss p=mark q=cage] :: outbound user req
[%init p=@p] :: report install
[%them p=(unit hiss)] :: outbound request
[%they p=@ud q=httr] :: inbound response
@ -2428,6 +2459,7 @@
== ::
++ gift-eyre :: out result <-$
$% [%mass p=mass] :: memory usage
[%sigh p=cage] :: marked http response
[%thou p=httr] :: raw http response
[%thus p=@ud q=(unit hiss)] :: http request/cancel
[%veer p=@ta q=path r=@t] :: drop-through
@ -2474,10 +2506,11 @@
[%bunt p=mark] :: example of mark
[%call p=silk q=silk] :: slam
[%cast p=mark q=silk] :: translate
[%core p=beam] :: build program
[%diff p=silk q=silk] :: diff
[%done p=(set beam) q=gage] :: literal
[%done p=(set beam) q=cage] :: literal
[%dude p=tank q=silk] :: error wrap
[%dune p=(set beam) q=(unit gage)] :: unit literal
[%dune p=(set beam) q=(unit cage)] :: unit literal
[%file p=beam] :: from clay
[%flag p=@uvH q=silk] :: re-apply user deps
[%join p=mark q=silk r=silk] :: merge
@ -2492,8 +2525,13 @@
[%volt p=(set beam) q=(cask ,*)] :: unsafe add type
== ::
::::
++ gage :: recursive cage/tang
$% [%& p=cage] :: success
[%| p=tang] :: error
[%tabl p=(list (pair gage gage))] :: table of results
==
++ gift-ford :: out result <-$
$% [%made p=@uvH q=(each gage tang)] :: computed result
$% [%made p=@uvH q=gage] :: computed result
[%mass p=mass] :: memory usage
[%news ~] :: fresh depends
== ::
@ -2506,14 +2544,18 @@
:::: %gall
::
++ club :: agent action
$% [%peer p=path] :: subscribe
$% [%peel p=mark q=path] :: translated peer
[%peer p=path] :: subscribe
[%poke p=cage] :: apply
[%puff p=mark q=noun] :: unchecked poke
[%pull ~] :: unsubscribe
[%punk p=mark q=cage] :: translated poke
[%pump ~] :: pump yes/no
== ::
++ cuft :: internal gift
$% [%coup p=(unit tang)] :: poke result
[%diff p=cage] :: subscription output
[%doff p=mark q=noun] :: untyped diff
[%quit ~] :: close subscription
[%reap p=(unit tang)] :: peer result
== ::

0
base/cat/bit/act/core.hook → base/cat/bit/act.hoon
View File

0
base/cat/bit/address-contact/gate.hook → base/cat/bit/address-contact.hoon
View File

0
base/cat/bit/auth/gate.hook → base/cat/bit/auth.hoon
View File

0
base/cat/bit/buy/gate.hook → base/cat/bit/buy.hoon
View File

10
base/cat/bit/buy/core.hook
View File

@ -1,10 +0,0 @@
::
::::
::
/? 314
::
:::::::
!:
|= [^ [amount=@t currency=@t ~] ~]
:- %buy
[amount currency]

0
base/cat/bit/contact-address/gate.hook → base/cat/bit/contact-address.hoon
View File

0
base/cat/bit/list/gate.hook → base/cat/bit/list.hoon
View File

0
base/cat/bit/sell/gate.hook → base/cat/bit/sell.hoon
View File

0
base/cat/bit/send/gate.hook → base/cat/bit/send.hoon
View File

30
base/cat/cat.hoon Normal file
View File

@ -0,0 +1,30 @@
:: ConCATenate file listings
::
:::: /hoon/cat/cat
::
// /%%/ls/subdir
// /%/pretty
!:
::::
::
|= [^ [arg=(list path)] ~]
=- tang/(flop `tang`(zing -))
%+ turn arg
|= pax=path
^- tang
=+ ark=;;(arch .^(%cy pax))
?^ q.ark
?: =(%sched -:(flop pax))
[>;;((map ,@da cord) .^(%cx pax))<]~
[leaf/(spud pax) (pretty-file .^(%cx pax))]
?- r.ark :: handle ambiguity
~
[rose/[" " `~]^~[leaf/"~" (smyt pax)]]~
[[@t ~] ~ ~]
$(pax (welp pax /[p.n.r.ark]))
*
=- [palm/[": " ``~]^-]~
:~ rose/[" " `~]^~[leaf/"*" (smyt pax)]
`tank`(subdir pax r.ark)
==
==

25
base/cat/cat/pretty.hoon Normal file
View File

@ -0,0 +1,25 @@
!:
|%
++ pretty-noun
|= pri=* ^- tank
?~ pri
leaf/"~"
?@ pri
leaf/?:(((sane %tas) pri) <`@tas`pri> <pri>)
=< rose/[" " ?:(- "~[" "[") "]"]^+
|- ^- [? (list tank)]
?~ +.pri
[& ^$(pri -.pri) ~]
?@ +.pri
[| ^$(pri -.pri) ^$(pri +.pri) ~]
[+< - +>]:[^$(pri -.pri) $(pri +.pri)]
::
++ vale-cord |=(a=cord `?`(levy (trip a) |=(b=@ |((gte b 32) =(10 b)))))
::
++ pretty-file
=+ wain-to-tang=|=(a=wain (turn a |=(b=cord leaf/(trip b))))
|= fyl=* ^- tang
=+ `(unit wain)`?@(fyl `(lore fyl) ((soft wain) fyl))
?^ - (wain-to-tang u)
[(pretty-noun fyl)]~
--

0
base/cat/coin/keys/gate.hook → base/cat/coin/keys.hoon
View File

9
base/cat/curl/url.hoon Normal file
View File

@ -0,0 +1,9 @@
::
::::
::
/? 310
::
:::::
!:
|= [^ [arg=tape ~] ~]
purl/(scan arg auri:epur)

2
base/cat/hello/gate.hook → base/cat/hello.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/hello/cat
:::: /hoon/hello/cat
::
/? 314
::

12
base/cat/helm/init/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/reload/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
:- %helm-init
p.bec

12
base/cat/helm/merge/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/merge/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[syd=@tas her=@p sud=@tas gem=?([?(%auto germ) ~] ~)] ~]
==
:- %helm-merge
[syd her sud ?~(gem %auto -.gem)]

11
base/cat/helm/start/gate.hook
View File

@ -1,11 +0,0 @@
::
:::: /hook/gate/start/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[who=@p dap=term ~] ~]
==
[%helm-start who dap]

12
base/cat/helm/sync/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/sync/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=[syd=@tas her=@p sud=@tas ~] ~]
==
:- %helm-sync
arg

15
base/cat/helm/unix/gate.hook
View File

@ -1,15 +0,0 @@
::
:::: /hook/gate/unix/helm/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[syd=@tas syn=?(~ [? ~])] ~]
==
:+ %helm-unix
syd
?~ syn
~
`-.syn

1
base/cat/hi/args/gate.hook
View File

@ -1 +0,0 @@
|=([^ args=[ship $|(~ [tape ~])] ~] hi-args/args)

2
base/cat/hi/txt/gate.hook
View File

@ -1,2 +0,0 @@
|= [^ [arg=cord ~] ~]
txt/arg

4
base/cat/helm/reload/gate.hook → base/cat/hood/breload.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/reload/helm/cat
:::: /hoon/reload/hood/cat
::
/? 314
::
@ -8,5 +8,5 @@
|= $: [now=@da eny=@uvI bec=beak]
[arg=(list term) ~]
==
:- %helm-reload
:+ %hood-reload-desk %base
arg

1
base/cat/hood/cp.hoon Normal file
View File

@ -0,0 +1 @@
|=([^ [input=path output=path ~] ~] kiln-cp/[input output])

1
base/cat/hood/hi.hoon Normal file
View File

@ -0,0 +1 @@
|=([^ [who=ship mez=$|(~ [a=tape ~])] ~] helm-send-hi/[who ?~(mez ~ `a.mez)])

2
base/cat/hood/init/gate.hook → base/cat/hood/init.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/reload/hood/cat
:::: /hoon/reload/hood/cat
::
/? 314
::

11
base/cat/hood/invite.hoon Normal file
View File

@ -0,0 +1,11 @@
::
:::: /hoon/invite/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[who=@p myl=@t ~] ~]
==
[%hood-invite who myl]

14
base/cat/hood/link.hoon Normal file
View File

@ -0,0 +1,14 @@
::
:::: /hoon/link/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI byk=beak]
[arg=$?([dap=term ~] [who=ship dap=term ~]) ~]
==
:- %hood-link
?~ +.arg
[p.byk dap.arg]
[who.arg dap.arg]

2
base/cat/hood/mass/gate.hook → base/cat/hood/mass.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/mass/hood/cat
:::: /hoon/mass/hood/cat
::
/? 314
::

2
base/cat/hood/merge/gate.hook → base/cat/hood/merge.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/merge/hood/cat
:::: /hoon/merge/hood/cat
::
/? 314
::

12
base/cat/hood/mount.hoon Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hoon/mount/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=[pax=path pot=@tas ~] ~]
==
:- %hood-mount
[pax pot]:arg

1
base/cat/hood/mv.hoon Normal file
View File

@ -0,0 +1 @@
|=([^ [input=path output=path ~] ~] kiln-cp/[input output])

12
base/cat/hood/reload-desk.hoon Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hoon/reload/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=[desk (list term)] ~]
==
:- %hood-reload-desk
arg

2
base/cat/hood/reload/gate.hook → base/cat/hood/reload.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/reload/hood/cat
:::: /hoon/reload/hood/cat
::
/? 314
::

7
base/cat/helm/mass/gate.hook → base/cat/hood/reset.hoon
View File

@ -1,12 +1,11 @@
::
:::: /hook/gate/reload/helm/cat
:::: /hoon/reset/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
[arg=~ ~]
==
:- %helm-mass
~
[%hood-reset ~]

1
base/cat/hood/rm.hoon Normal file
View File

@ -0,0 +1 @@
|=([^ [input=path ~] ~] kiln-rm/input)

1
base/cat/hood/schedule.hoon Normal file
View File

@ -0,0 +1 @@
|=([^ [where=path tym=@da eve=@t ~] ~] kiln-schedule/[where tym eve])

15
base/cat/hood/start.hoon Normal file
View File

@ -0,0 +1,15 @@
::
:::: /hoon/start/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=[@ $|(~ [@ ~])] ~]
==
:- %hood-start
?> ((sane %tas) -.arg)
?@ +.arg [%home -.arg]
?> ((sane %tas) +<.arg)
[-.arg +<.arg]

11
base/cat/hood/start/gate.hook
View File

@ -1,11 +0,0 @@
::
:::: /hook/gate/start/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[who=@p dap=term ~] ~]
==
[%hood-start who dap]

2
base/cat/hood/sync/gate.hook → base/cat/hood/sync.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/sync/hood/cat
:::: /hoon/sync/hood/cat
::
/? 314
::

2
base/cat/hood/unix/gate.hook → base/cat/hood/unix.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/unix/hood/cat
:::: /hoon/unix/hood/cat
::
/? 314
::

12
base/cat/hood/unmount.hoon Normal file
View File

@ -0,0 +1,12 @@
::
:::: /hoon/mount/hood/cat
::
/? 314
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[[mon=$|(term [span path]) ~] ~]
==
:- %hood-unmount
mon

4
base/dog/hood/verb/gate.hook → base/cat/hood/verb.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/verb/hood/gun
:::: /hoon/verb/hood/gun
::
/? 314
/- *sole
@ -10,4 +10,4 @@
[~ ~]
==
~& %hood-verb
(sole-so %hood-verb ~)
[%helm-verb ~]

11
base/cat/ls.hoon Normal file
View File

@ -0,0 +1,11 @@
:: LiSt directory subnodes
::
:::: /hoon/ls/cat
::
// /%/subdir
!:
::::
::
|= [^ [arg=path ~] ~]
=+ lon=((hard arch) .^(%cy arg))
tang/[?~(r.lon leaf/"~" (subdir arg r.lon))]~

20
base/cat/ls/subdir.hoon Normal file
View File

@ -0,0 +1,20 @@
|%
++ subdir
|= [pax=path des=(map ,@t ,~)]
^- tank
:+ %rose [" " `~]
%+ turn (sort (~(tap by des)) aor)
|= [kid=@ta ~]
=+ paf=`path`/[kid]
=- :+ %rose ["/" ~ ?:(dir "/" ~)]
(turn paf |=(a=span leaf/(trip a)))
|- ^- [dir=? paf=path]
=+ arf=;;(arch .^(%cy (weld pax paf)))
?^ q.arf
[| paf]
?~ r.arf
[& paf] :: !!
?. ?=([^ ~ ~] r.arf)
[& paf]
$(paf (welp paf /[p.n.r.arf]))
--

5
base/dog/solid/gate.hook → base/cat/solid.hoon
View File

@ -1,15 +1,14 @@
::
:::: /hook/gate/solid/gun
:::: /hoon/solid/cat
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
%+ sole-so %noun
:- %noun
=+ top=`path`/(scot %p p.bec)/home/(scot %da now)/arvo
=+ pax=`path`(weld top `path`[%hoon ~])
~& %solid-start

2
base/cat/ticket/gate.hook → base/cat/ticket.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/ticket/cat
:::: /hoon/ticket/cat
::
/? 314
::

20
base/cat/tree.hoon Normal file
View File

@ -0,0 +1,20 @@
:: Tree view recursive directory contents
::
:::: /hoon/tree/cat
::
!:
::::
::
|= [^ [pax=path fla=$|(~ [%full ~])] ~]
=+ len=(lent pax)
=+ rend=?^(fla dank:ut |=(a=path (dank:ut (slag len a))))
:- %tang %- flop
|- ^- tang
=+ ark=;;(arch .^(cy/pax))
=- ?~ q.ark -
[(rend pax) -]
%- zing
%+ turn
(sort (~(tap by r.ark)) aor)
|= [a=@t ~]
^$(pax (welp pax /[a]))

8
base/cat/twit/as.hoon Normal file
View File

@ -0,0 +1,8 @@
/- *twitter
::
::::
::
|= $: [now=@da eny=@uvI bec=beak]
[[who=span msg=cord ~] ~]
==
[%twit-do [who %post eny msg]]

13
base/cat/twit/tweet.hoon Normal file
View File

@ -0,0 +1,13 @@
/+ sh-utils
!:
|_ [hide ~]
++ peer ,_`.
++ poke--args
%+ add-subs [[our /twit] our /post/(scot %uv eny)]
%^ gate-mess .
|=([a=span b=cord ~] [/twit %twit-do !>([a %post eny b])])
,_`.
++ posh-twit-stat
(args-into-gate . |=([@ @ a=@da @] tang/~[leaf/"Tweet recieved {<a>}"]))
++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

22
base/cat/twit/twitter-feed.hoon Normal file
View File

@ -0,0 +1,22 @@
:: Display twitter feed
::
:::: /hook/core/twitter-feed/app
::
/+ sh-utils
!:
::
:::: ~fyr
::
|_ [hide ~]
++ stat ,[id=@u who=@ta now=@da txt=@t]
++ rens
|=(stat rose/[": " `~]^~[leaf/"{<now>} @{(trip who)}" leaf/(trip txt)])
++ peer ,_`.
++ poke--args
|= [ost=bone his=ship who=span ~]
%.(+< (add-subs [[our /twit] our /user/[who]] ,_`+>.$))
::
++ posh-twit-feed
(args-into-gate . |=(a=(list stat) tang/(turn a rens)))
:: ++ pour |*([ost=@ * sih=[@ ^]] :_(+>.$ [ost %give +.sih]~))
--

45
base/dog/helm/begin/gate.hook
View File

@ -1,45 +0,0 @@
::
:::: /hook/gate/begin/helm/gun
::
/? 314
/- *sole
::
::::
!:
=> |%
++ begs ,[his=@p tic=@p yen=@t ges=gens]
--
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
^- (sole-result (cask begs))
%+ sole-lo
[%& %helm-begin "your ship: ~"]
%+ sole-go fed:ag
|= his=@p
%+ sole-lo
[%& %helm-ticket "your ticket: ~"]
%+ sole-go fed:ag
|= tic=@p
%+ sole-lo
[%& %helm-entropy "some entropy: "]
%+ sole-go (boss 256 (more gon qit))
|= yen=@t
=+ ney=(shax yen)
%+ sole-yo `tank`[%leaf "entropy check: {(scow %p `@p`(mug ney))}"]
%+ sole-so %helm-begin
:* his
tic
ney
::
^- gens
:- %en
=+ can=(clan his)
?- can
%czar [%czar ~]
%duke [%duke %anon ~]
%earl [%earl (scot %p his)]
%king [%king ?:(=(~doznec his) 'Urban Republic' (scot %p his))]
%pawn [%pawn ~]
==
==

12
base/dog/helm/reload/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/reload/helm/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=(list term) ~]
==
(sole-so %helm-reload arg)

12
base/dog/helm/reset/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/reset/helm/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
(sole-so %helm-reset ~)

13
base/dog/helm/verb/gate.hook
View File

@ -1,13 +0,0 @@
::
:::: /hook/gate/verb/helm/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@ bec=beak]
[~ ~]
==
~& %helm-verb
(sole-so %helm-verb ~)

2
base/dog/hood/begin/gate.hook → base/dog/hood/begin.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/gate/begin/hood/gun
:::: /hoon/begin/hood/gun
::
/? 314
/- *sole

12
base/dog/hood/reload/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/reload/hood/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[arg=(list term) ~]
==
(sole-so %hood-reload arg)

12
base/dog/hood/reset/gate.hook
View File

@ -1,12 +0,0 @@
::
:::: /hook/gate/reset/hood/gun
::
/? 314
/- *sole
::
::::
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
(sole-so %hood-reset ~)

21
base/dog/twit/auth.hoon Normal file
View File

@ -0,0 +1,21 @@
:: Input twitter keys
/- *sole, *twitter
!:
|%
++ baz64 (cook crip (star alp))
--
!:
|= $: [now=@da eny=@uvI bec=beak]
[~ ~]
==
^- (sole-result (cask twit-do))
%+ sole-lo [%& %$ "User: "] %+ sole-go urs:ab |= acc=span
%+ sole-lo [%& %$ "App token: "] %+ sole-go baz64 |= ctok=cord
%+ sole-lo [%& %$ "App secret: "] %+ sole-go baz64 |= csec=cord
%+ sole-lo [%& %$ "User token: "] %+ sole-go baz64 |= atok=cord
%+ sole-lo [%& %$ "User secret: "] %+ sole-go baz64 |= asec=cord
(sole-so %twit-do [acc %auth [ctok csec] atok asec])

5
base/dog/twit/auth/hoontap-keys.txt Normal file
View File

@ -0,0 +1,5 @@
hoontap
AP3G1t8ki6rPzeeAqdWCTw03F
VV784LPwZSaAxtF16RWWTnST4F85BHN8VqQKNyv7MprCkA0xZD
2821727326-RZGXSeTn7hCFQfJqR0ViivM3YYpu2O1M71gelBl
jW9VygFPOTsEK0WmrJDHYSoEnofOPdCE1oQRzueemVTl8

0
base/psal.hook → base/elem.hook
View File

67
base/lib/drum/core.hook → base/lib/drum.hoon
View File

@ -1,5 +1,5 @@
:: :: ::
:::: /hook/core/drum/lib :: ::
:::: /hoon/drum/lib :: ::
:: :: ::
/? 310 :: version
!: :: ::
@ -65,7 +65,7 @@
?: =(%pawn myr)
[[%base %dojo] ~]
?: =(%earl myr) ~
[[%home %dojo] [%home %talk] ~]
[[%home %talk] [%home %dojo] ~]
::
++ deft-fish :: default connects
|= our=ship
@ -76,8 +76,8 @@
[[our %dojo] ~]
?: =(%earl myr)
=+ dad=(sein our)
[[dad %dojo] [dad %talk] ~]
[[our %dojo] [our %talk] ~]
[[dad %talk] [dad %dojo] ~]
[[our %talk] [our %dojo] ~]
::
++ deft-mast :: default master
|= our=ship
@ -115,18 +115,19 @@
::
++ drum-path :: encode path
|= gyl=gill
[%drum (scot %p p.gyl) q.gyl ~]
[%drum %phat (scot %p p.gyl) q.gyl ~]
::
++ drum-phat :: decode path
|= way=wire ^- gill
?>(?=([@ @ ~] way) [(slav %p i.way) i.t.way])
::
++ drum-work :: work in drum
|= [[hide from] drum-part]
|= [bowl drum-part]
=+ (fall (~(get by bin) ost) (deft-pipe our))
=> |% :: arvo structures
++ pear :: request
$% [%sole-action p=sole-action] ::
[%talk-command command:talk] ::
== ::
++ lime :: update
$% [%dill-blit dill-blit] ::
@ -154,7 +155,7 @@
(most ;~(plug com ace) sp-gill)
%+ cook
|= a=ship
[[a %dojo] [a %talk] ~]
[[a %talk] [a %dojo] ~]
;~(pfix sig fed:ag)
==
::
@ -175,7 +176,7 @@
--
--
|_ [moz=(list move) biz=(list dill-blit)]
++ diff-sole-effect ::
++ diff-sole-effect-phat ::
|= [way=wire fec=sole-effect]
=< se-abet =< se-view
=+ gyl=(drum-phat way)
@ -202,7 +203,12 @@
=< se-abet =< se-view
(se-born wel)
::
++ reap ::
++ poke-link ::
|= gyl=gill
=< se-abet =< se-view
(se-link gyl)
::
++ reap-phat ::
|= [way=wire saw=(unit tang)]
=< se-abet =< se-view
=+ gyl=(drum-phat way)
@ -210,13 +216,13 @@
(se-join gyl)
(se-dump:(se-drop & gyl) u.saw)
::
++ take-coup ::
++ take-coup-phat ::
|= [way=wire saw=(unit tang)]
=< se-abet =< se-view
?~ saw +>
=+ gyl=(drum-phat way)
?: (se-aint gyl) +>.$
~& [%drum-coup-fail src ost gyl u.saw]
=. u.saw :_(u.saw >[%drum-coup-fail src ost gyl]<)
(se-dump:(se-drop & gyl) u.saw)
::
++ take-onto ::
@ -228,11 +234,11 @@
?- -.saw
%| (se-dump p.saw)
%& ?> =(q.wel p.p.saw)
:: =. +>.$ (se-text "[{<p.saw>}]")
:: =. +>.$ (se-text "live {<p.saw>}")
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
::
++ quit
++ quit-phat ::
|= way=wire
=< se-abet =< se-view
=+ gyl=(drum-phat way)
@ -243,6 +249,9 @@
:: :: ::
++ se-abet :: resolve
^- (quip move *drum-part)
?. se-ably
=. . se-adit
[(flop moz) +>+>+<+]
=. . se-adze:se-adit
:_ %_(+>+>+<+ bin (~(put by bin) ost `source`+>+<))
^- (list move)
@ -251,6 +260,7 @@
?~ biz ~
[ost %diff %dill-blit ?~(t.biz i.biz [%mor (flop biz)])]~
::
++ se-ably (~(has by sup) ost) :: caused by console
++ se-adit :: update servers
=+ yar=(~(tap by ray))
|- ^+ +>
@ -260,6 +270,7 @@
%= $
yar t.yar
+>
=. +>.$ (se-text "activated app {(trip p.i.yar)}/{(trip q.i.yar)}")
%- se-emit(fur (~(put by fur) q.i.yar ~))
[ost %conf [%drum p.i.yar q.i.yar ~] [our q.i.yar] %load our p.i.yar]
==
@ -338,14 +349,6 @@
(se-text "[already running {<p.wel>}/{<q.wel>}]")
+>(ray (~(put in ray) wel), eel (~(put in eel) [our q.wel]))
::
++ se-dump :: print tanks
|= tac=(list tank)
^+ +>
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
::
++ se-drop :: disconnect
|= [pej=? gyl=gill]
^+ +>
@ -356,9 +359,18 @@
=. +>.$ ?. &(?=(^ lag) !=(gyl u.lag))
+>.$(inx 0)
(se-alas u.lag)
=. +>.$ (se-text "[detached from {<gyl>}]")
=. +>.$ (se-text "[unlinked from {<gyl>}]")
se-prom(liv.maz ?~(fug & liv.maz))
::
++ se-dump :: print tanks
|= tac=(list tank)
^+ +>
?. se-ably (se-talk tac)
=+ wol=`wall`(zing (turn (flop tac) |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>.^$ (se-blit %out (tuba i.wol)))
::
++ se-joke :: prepare connection
|= gyl=gill
^+ +>
@ -370,7 +382,7 @@
++ se-join :: confirm connection
|= gyl=gill
^+ +>
=. +> (se-text "[connected to {<gyl>}]")
=. +> (se-text "[linked to {<gyl>}]")
?> =(~ (~(got by fug) gyl))
(se-alas:se-prom(liv.maz |, fug (~(put by fug) gyl `*target)) gyl)
::
@ -467,8 +479,15 @@
|= mov=move
%_(+> moz [mov moz])
::
++ se-talk
|= tac=(list tank)
^+ +>
(se-emit 0 %poke /drum/talk [our %talk] (said our %drum now eny tac))
::
++ se-text :: return text
|= txt=tape
^+ +>
?. se-ably (se-talk [%leaf txt]~)
(se-blit %out (tuba txt))
::
++ se-poke :: send a poke
@ -772,7 +791,7 @@
::
++ ta-tan :: print tanks
|= tac=(list tank)
=+ wol=`wall`(zing (turn tac |=(a=tank (~(win re a) [0 edg]))))
=+ wol=`wall`(zing (turn (flop tac) |=(a=tank (~(win re a) [0 edg]))))
|- ^+ +>.^$
?~ wol +>.^$
$(wol t.wol, +>+>.^$ (se-text i.wol))

59
base/lib/helm/core.hook → base/lib/helm.hoon
View File

@ -1,5 +1,5 @@
:: :: ::
:::: /hook/core/helm/lib :: ::
:::: /hoon/helm/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
@ -27,10 +27,6 @@
++ hood-init :: report init
$: him=ship ::
== ::
++ hood-start :: start (local) server
$: syd=desk :: desk
dap=term :: program
== ::
++ hood-reset :: reset command
,~ ::
++ helm-verb :: reset command
@ -43,17 +39,22 @@
!: :: ::
|% :: helm library
++ helm-work :: work in helm
|= [[hide from] helm-part]
|= [bowl helm-part]
=+ sez=(fall (~(get by hoc) ost) *helm-session)
=> |% :: arvo structures
++ card ::
$% [%cash wire p=@p q=buck] ::
[%conf wire dock %load ship term] ::
[%flog wire flog] ::
[%plug wire @p @tas @p @tas] ::
[%poke wire dock pear] ::
[%want wire sock path *] :: send message
== ::
++ move (pair bone card) :: user-level move
++ pear :: poke fruit
$% [%hood-unsync desk ship desk] ::
[%talk-command command:talk] ::
[%helm-hi cord] ::
== ::
--
|_ moz=(list move)
++ abet :: resolve
@ -78,19 +79,28 @@
(emit %flog /helm %crud %hax-init leaf/(scow %p him) ~)
::
++ poke-mass
=< abet
|= ~ =< abet
(emit %flog /heft %crud %hax-heft ~)
::
++ poke-start :: start a server
|= hood-start =< abet
(emit %conf /helm [our dap] %load our syd)
++ poke-send-hi
|= [her=ship mes=(unit tape)] =< abet
%^ emit %poke /helm/hi/(scot %p her)
[[her %hood] %helm-hi ?~(mes '' (crip u.mes))]
::
++ poke-reload :: reload vanes
|= all=(list term) =< abet
++ poke-hi |=(mes=@t abet:(emit %flog /di %text "< {<src>}: {(trip mes)}"))
++ coup-hi
|= [pax=path cop=(unit tang)] =< abet
?> ?=([@t ~] pax)
(emit %flog ~ %text "hi {(trip i.pax)} {?~(cop "" "un")}succesful")
::
++ poke-reload |=(all=(list term) (poke-reload-desk %home all))
++ poke-reload-desk :: reload vanes
|= [syd=desk all=(list term)] =< abet
%- emil
%- flop
%+ turn all
=+ ark=(arch .^(%cy /(scot %p our)/base/(scot %da lat)/arvo))
=+ top=`path`/(scot %p our)/[syd]/(scot %da now)/arvo
=+ ark=(arch .^(%cy top))
=+ van=(~(tap by r.ark))
|= nam=@tas
=. nam
@ -101,17 +111,21 @@
?> ?=([[@ ~] ~] zaz)
`term`p.i.zaz
=+ tip=(end 3 1 nam)
=+ way=[(scot %p our) %home (scot %da lat) %arvo nam %hoon ~]
=+ fil=(,@ .^(%cx way))
:* %flog
/reload
[%veer ?:(=('z' tip) %$ tip) way (,@ .^(%cx way))]
==
=+ way=(welp top /[nam])
=+ fil=(,@ .^(%cx (welp way /hoon)))
[%flog /reload [%veer ?:(=('z' tip) %$ tip) way fil]]
::
++ poke-invite :: send invite; fake
|= [who=@p myl=@t] =< abet
%^ emit %poke /helm/invite
:- [our %talk]
(said our %helm now eny [%leaf "invited: {<who>} at {(trip myl)}"]~)
::
++ poke-reset :: reset system
|= hood-reset =< abet
%- emil
=+ top=`path`/(scot %p our)/base/arvo/(scot %da lat)
%- flop ^- (list card)
=+ top=`path`/(scot %p our)/home/(scot %da now)/arvo
:- [%flog /reset %vega (weld top `path`/hoon)]
%+ turn
^- (list ,[p=@tas q=@tas])
@ -136,7 +150,7 @@
=< abet
%- emil(bur ~)
:~ [%cash /helm p.u.bur q.u.bur u.wil]
[%plug /helm our %home (sein our) %kids]
[%poke /helm [our %hood] %hood-unsync %base (sein our) %kids]
==
::
++ poke-verb :: toggle verbose
@ -145,7 +159,6 @@
::
++ take-onto :: result of %conf
|= saw=(each suss tang) =< abet
~& [%take-onto saw]
%- emit
?- -.saw
%| [%flog ~ %crud %onto `tang`p.saw]

36
base/lib/http.hoon Normal file
View File

@ -0,0 +1,36 @@
::
:::: /hoon/http/lib
::
::
::
/? 310
!:
|%
++ httpreq
|= $: ost=bone pour-path=wire
$= params
$: domain=(list cord) end-point=path
req-type=$?(%get [%post json]) headers=math
queries=quay
==
==
:^ ost %them pour-path
`(unit hiss)`[~ (httpreq-to-hiss params)]
::
++ httpreq-to-hiss
|= $: domain=(list cord) end-point=path
req-type=$?(%get [%post p=json]) headers=math
queries=quay
==
^- hiss :: cast to hiss
=- ~& hiss=- -
:- ^- parsed-url=purl
:+ :+ security=%.y
port=~
host=[%.y [path=domain]]
endpoint=[extensions=~ point=end-point] :: ++pork,
q-strings=queries :: ++quay
?@ req-type
[%get headers ~]
[%post headers ~ (tact (pojo p.req-type))]
--

28
base/lib/http/core.hook
View File

@ -1,28 +0,0 @@
::
:::: /hook/core/sole/lib;
::
::
::
/? 310
!:
|%
++ httpreq
|= $: ost=bone pour-path=wire
domain=(list cord) end-point=path
req-type=$?(%get [%post json]) headers=math
queries=quay
==
=+ ^- parsed-url=purl
:+ :+ security=%.y
port=~
host=[%.y [path=domain]]
endpoint=[extensions=~ point=end-point] :: ++pork,
q-strings=queries :: ++quay
=+ ^- request=hiss :: cast to hiss
:- parsed-url
?@ req-type
[%get headers ~]
[%post headers ~ (tact (pojo +.req-type))]
:^ ost %them pour-path
`(unit hiss)`[~ request]
--

290
base/lib/kiln/core.hook → base/lib/kiln.hoon
View File

@ -1,5 +1,5 @@
:: :: ::
:::: /hook/core/kiln/lib :: ::
:::: /hoon/kiln/lib :: ::
:: :: ::
/? 310 :: version
:: :: ::
@ -9,7 +9,8 @@
++ kiln-part ,[%kiln %0 kiln-pith] :: kiln state
++ kiln-pith ::
$: rem=(map desk kiln-desk) ::
==
syn=(map hood-sync ,[let=@ud ust=bone]) ::
== ::
++ kiln-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
@ -20,45 +21,52 @@
:: :: ::
:::: :: ::
:: :: ::
++ hood-unix ::
$: syd=desk ::
syn=(unit bean) ::
++ hood-mount ::
$: pax=path ::
pot=term ::
== ::
++ hood-unmount ::
$|(term [span path]) ::
++ hood-sync ::
$: syd=desk ::
her=ship ::
sud=desk ::
== ::
++ hood-unsync ::
$: syd=desk ::
her=ship ::
sud=desk ::
== ::
++ hood-merge ::
$: syd=desk ::
ali=ship ::
sud=desk ::
gim=?(%auto germ) ::
== ::
++ hood-cp [input=path output=path] ::
++ hood-mv [input=path output=path] ::
-- ::
:: :: ::
:::: :: ::
!: :: ::
|% :: kiln library
++ kiln-work :: work in kiln
|= [[hide from] kiln-part]
|= [bowl kiln-part]
?> =(src our)
=> |% :: arvo structures
++ card ::
$% [%exec wire @p beak (unit silk)] ::
[%font wire @p @tas @p @tas] ::
[%info wire @p @tas nori] ::
[%lynx wire @p @tas (unit ,?)] ::
[%mont wire @tas @p @tas path] ::
[%ogre wire $|(@tas beam)] ::
[%merg wire @p @tas @p @tas germ] ::
[%plug wire @p @tas @p @tas] ::
[%poke wire dock pear] ::
[%warp wire sock riff] ::
== ::
++ pear :: poke fruit
$% [%talk-command command:talk] ::
[%hood-merge hood-merge] ::
== ::
++ tage :: %tabl gage
,[[%tabl p=(list (pair marc marc))] q=vase] ::
++ move (pair bone card) :: user-level move
--
|_ moz=(list move)
@ -71,42 +79,195 @@
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ poke-unix ::
|= hood-unix
abet:(emit %lynx /kiln our syd syn)
++ poke-mount
|= hood-mount
=+ bem=(tome pax)
?~ bem
=+ "can't mount bad path: {<pax>}"
abet:(spam leaf/- ~)
abet:(emit %mont /mount pot p.u.bem q.u.bem (flop s.u.bem))
::
++ poke-unmount
|= mon=hood-unmount
?^ mon
=+ bem=(tome mon)
?~ bem
=+ "can't unmount bad path: {<mon>}"
abet:(spam leaf/- ~)
abet:(emit %ogre /unmount-beam [[p q %ud 0] s]:u.bem)
abet:(emit %ogre /unmount-point mon)
::
++ poke-sync ::
|= hood-sync
abet:(emit %font /kiln our syd her sud)
|= hos=hood-sync
?: (~(has by syn) hos)
=+ "already syncing from {<sud.hos>} on {<her.hos>} to {<syd.hos>}"
abet:(spam leaf/- ~)
abet:abet:start:(auto hos)
::
++ poke-unsync ::
|= hus=hood-unsync
?. (~(has by syn) hus)
=+ "not syncing from {<sud.hus>} on {<her.hus>} to {<syd.hus>}"
abet:(spam leaf/- ~)
%* . abet:abet:stop:(auto hus)
syn (~(del by syn) hus)
==
::
++ poke-merge ::
|= hood-merge
abet:abet:(merge:(work syd) ali sud gim)
::
++ do-info
|= [mez=tape tor=toro]
abet:(emit:(spam leaf/mez ~) %info /kiln our tor)
::
++ poke-rm |=(a=path (do-info "removed" (fray a)))
++ poke-cp
|= [input=path output=path]
%+ do-info "copied"
?> =(-:(flop input) -:(flop output))
(foal output -:(flop input) %noun .^(%cx input)) :: XX type
::
++ poke-mv
|= [input=path output=path]
%+ do-info "moved"
?> =(-:(flop input) -:(flop output))
%+ furl (fray output)
(foal output -:(flop input) %noun .^(%cx input))
::
++ poke-schedule
|= [where=path tym=@da eve=@t]
=. where (welp where /sched)
%+ do-info "scheduled"
=+ old=;;((map ,@da cord) (fall (file where) ~))
(foal where %sched !>((~(put by old) tym eve)))
::
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))]
abet:abet:(mere:(take way) are)
::
++ take-made ::
|= [way=wire dep=@uvH reg=(each gage tang)]
|= [way=wire dep=@uvH reg=gage]
abet:abet:(made:(take way) dep reg)
::
++ take-coup-fancy ::
|= [way=wire saw=(unit tang)]
abet:abet:(coup-fancy:(take way) saw)
::
++ take-mere-sync ::
|= [way=wire mes=(each (set path) (pair term tang))]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(mere:(auto hos) mes)
::
++ take-writ ::
|= [way=wire rot=riot]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ spam
|= mes=(list tank)
%- emit
[%poke /kiln/spam [our %talk] (said our %kiln now eny mes)]
::
++ auto
|= hood-sync
=+ (fall (~(get by syn) syd her sud) [let=*@ud ust=ost])
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let ust))
::
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
::
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam leaf/"ended autosync from {<sud>} on {<her>} to {<syd>}" ~)
%- blab :_ ~
:* ust %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~
==
::
++ start
:: XX remove feedback for demo
:: =. . %- spam
:: [leaf/"activated sync from {<sud>} on {<her>} to {<syd>}" ~]
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %w [%da now] /
==
::
++ writ
|= rot=riot
?~ rot
%^ spam
leaf/"bad %writ response on sync"
leaf/"from {<sud>} on {<her>} to {<syd>}"
~
=. let ?. ?=(%w p.p.u.rot) let ((hard ,@ud) q.q.r.u.rot)
%- blab :_ ~
:* ost %merg
/kiln/sync/[syd]/(scot %p her)/[sud]
our syd her sud
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da now)))
%init
%mate
==
::
++ mere
|= mes=(each (set path) (pair term tang))
=. let +(let)
=. +>.$
%- spam
?: ?=(%& -.mes)
~
:: [leaf/"sync succeeded from {<sud>} on {<her>} to {<syd>}" ~]
?+ p.p.mes
:* leaf/"sync failed from {<sud>} on {<her>} to {<syd>}"
leaf/"please manually merge the desks with"
leaf/":+merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf/""
leaf/"error code: {<p.p.mes>}"
q.p.mes
==
::
%no-ali-desk
:~ leaf/"sync activated from {<sud>} on {<her>} to {<syd>}"
leaf/"note: {<sud>} on {<her>} is a blank desk"
==
==
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %y [%ud let] /
==
--
::
++ work :: state machine
|= syd=desk
=+ ^- kiln-desk
%+ fall (~(get by rem) syd)
=+ *kiln-desk
%_(- cas [%da lat])
%_(- cas [%da now])
|%
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab :: emit, XX remove
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
@ -115,24 +276,40 @@
++ lose
^+ .
~| %kiln-work-fail
!!
.
::
++ gage-to-tage ::
|= res=gage
^- tage
?@ p.res
~|(%bad-marc !!)
res
++ ford-fail
|=(tan=tang ~|(%ford-fail (mean tan)))
::
++ tage-to-cages ::
|= tab=tage
^- (list (pair cage cage))
?~ p.tab
~
:_ $(p.tab t.p.tab, q.tab (slot 3 q.tab))
~| %strange-gage
:- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)]
[?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)]
++ unwrap-tang
|* res=(each ,* tang)
?: ?=(%& -.res)
p.res
(ford-fail p.res)
::
++ gage-to-cages
|= gag=gage ^- (list (pair cage cage))
(unwrap-tang (gage-to-tage gag))
::
++ gage-to-tage
|= gag=gage
^- (each (list (pair cage cage)) tang)
?. ?=(%tabl -.gag)
(mule |.(`~`(ford-fail >%strange-gage< ~)))
=< ?+(. [%& .] [@ *] .)
|- ^- ?((list ,[cage cage]) (each ,~ tang))
?~ p.gag ~
=* hed i.p.gag
?- -.p.hed
%tabl (mule |.(`~`(ford-fail >%strange-gage< ~)))
%| (mule |.(`~`(ford-fail p.p.hed)))
%& ?- -.q.hed
%tabl (mule |.(`~`(ford-fail >%strange-gage< ~)))
%| (mule |.(`~`(ford-fail p.q.hed)))
%& =+ $(p.gag t.p.gag)
?+(- [[p.p p.q]:hed -] [@ *] -)
== ==
::
++ perform ::
^+ .
@ -144,35 +321,14 @@
%- blab :_ ~
[ost %poke /kiln/fancy/[^syd] [our %hood] %hood-merge [syd her sud gem]]
::
++ spam
|= mes=(list tank)
%- blab :_ ~
:* ost %poke /kiln/spam/[syd]
[our %talk] %talk-command
^- command:talk
:- %publish
%- flop
=< acc
%+ roll mes
=< .(eny eny)
|= [tan=tank acc=(list thought:talk) eny=@uvI]
^- [acc=(list thought:talk) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought:talk
:+ -
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
[lat *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ spam |*(* +>(..work (^spam +<)))
++ merge
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
=. cas [%da lat]
=. cas [%da now]
?. ?=(%auto gim)
perform(auto |, gem gim, her her, sud sud)
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da lat)))
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da now)))
=> $(gim %init)
.(auto &)
=> $(gim %fine)
@ -194,22 +350,22 @@
?: =(%meld gem)
?: ?=(%& -.are)
?. auto
=+ "successfully merged with strategy {<gem>}"
=+ "merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
=+ "mashing conflicts"
=> .(+>.$ (spam leaf/- ~))
=+ tic=(cat 3 syd '-scratch')
%- blab :_ ~
:* ost %exec /kiln/[syd]
our [our tic %da lat] ~ %tabl
our [our tic %da now] ~ %tabl
^- (list (pair silk silk))
%+ turn (~(tap in p.are))
|= pax=path
^- (pair silk silk)
:- [%done ~ %path -:!>(*path) pax]
=+ base=[%file [our tic %da lat] (flop pax)]
=+ base=[%file [our tic %da now] (flop pax)]
=+ alis=[%file [her sud cas] (flop pax)]
=+ bobs=[%file [our syd %da lat] (flop pax)]
=+ bobs=[%file [our syd %da now] (flop pax)]
=+ dali=[%diff base alis]
=+ dbob=[%diff base bobs]
=+ ^- for=mark
@ -220,7 +376,7 @@
=+ "failed to merge with strategy {<p.p.are>}"
lose:(spam leaf/- q.p.are)
?: ?=(%& -.are)
=+ "successfully merged with strategy {<gem>}"
=+ "merged with strategy {<gem>}"
win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~]))
?. auto
=+ "failed to merge with strategy {<p.p.are>}"
@ -260,13 +416,13 @@
==
::
++ made
|= [dep=@uvH reg=(each gage tang)]
|= [dep=@uvH reg=gage]
^+ +>
?: ?=(%| -.reg)
=+ "failed to mash"
lose:(spam leaf/- p.reg)
=+ ^- can=(list (pair path (unit miso)))
%+ turn (tage-to-cages (gage-to-tage p.reg))
%+ turn (gage-to-cages reg)
|= [pax=cage dif=cage]
^- (pair path (unit miso))
?. ?=(%path p.pax)
@ -306,7 +462,7 @@
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd]/dash
:* ost %info /kiln/[syd]
our (cat 3 syd '-scratch')
%& *cart
%+ murn can

42
base/lib/oct1.hoon Normal file
View File

@ -0,0 +1,42 @@
:: :: ::
:::: /hoon/oct1/lib :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *oct1 :: structures
:: :: ::
:::: :::::: semantics
!: :: ::
|% ::
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ bit |=(@ =(1 (cut 0 [+< 1] bud))) :: moved at address
++ get |=(point (bit (off +<))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: play from
|_ game ::
++ at |_ point :: per point
++ g +>+< :: game
++ k !|(x o) :: legal move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<)) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<)) :: play at x
-- ::
++ new +<(boo 0, box 0, who &) :: reset game
++ res ?. |(~(win bo box) ~(win bo boo)) :: possible result
?: =(511 (con boo box)) ::
`"tie :-(" ~ `"{<~[(icon who)]>} wins" ::
++ row |= y=@ :- (add y '1') %- zing :: print row
(turn (gulf 0 3) |=(@ ~[' ' ~(v at y +<)])) ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
++ voy ": {<~[(icon who)]>} (row/col): " :: print prompt
--
--

58
base/lib/oct2.hoon Normal file
View File

@ -0,0 +1,58 @@
:: :: ::
:::: /hoon/oct2/lib :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *oct2 :: structures
:: :: ::
:::: :::::: semantics
!: :: ::
|% ::
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ bit |=(@ =(1 (cut 0 [+< 1] bud))) :: moved at address
++ get |=(point (bit (off +<))) :: get point
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: play from
|_ [src=ship game] ::
++ at |_ point :: per point
++ g `game`+>+<+ :: game
++ k &(!|(x o) ept) :: legal move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<), q.sag `src) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<), p.sag `src) :: play at x
-- ::
++ ept =+(own |(&(=(~ -) !=(oth `src)) =(`src -))) :: we can play
++ hey |=(? +>+<+(aud ((stat ship) +< src aud))) :: enter/leave
++ muy |= (list ship) ?~ +< +>+<+ :: many in audience
$(+< t.+<, aud ((stat ship) & i.+< aud)) ::
++ nam =+ ?: =(p.sag `src) ['=' (icon &) ~] :: print name
?: =(q.sag `src) ['=' (icon |) ~] ::
"" (welp (scow %p src) `tape`-) ::
++ new +<+(boo 0, box 0, who &, sag [~ ~]) :: reset game
++ oth own(who !who) :: who owns other turn
++ own ?:(who p.sag q.sag) :: who owns this turn
++ res ?. |(~(win bo box) ~(win bo boo)) :: possible result
?: =(511 (con boo box)) ::
`"tie :-(" ~ `"{<nam>} wins" ::
++ row |= y=@ :- (add y '1') %- zing :: print row
(turn (gulf 0 3) |=(@ ~[' ' ~(v at y +<)])) ::
++ str =+ [own ~[(icon who)]] ^- tape :: print player
?~(-< -> (scow %p u.-<)) ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
++ vew =- ?: =(~ -) ~ :(weld "[" - "]") :: print watchers
=+ dow=(~(tap by aud)) |- ^- tape ::
?~ dow ~ =+ mor=$(dow t.dow) ::
:(weld nam(src p.i.dow) ?~(mor "" ", ") mor) ::
++ voy =+ ~[(icon who)] %+ weld vew :: print prompt
?.(ept " ({-}'s turn) " ": {-} (row/col): ")::
--
--

59
base/lib/oct3.hoon Normal file
View File

@ -0,0 +1,59 @@
:: :: ::
:::: /hoon/oct3/lib :::::: dependencies
:: :: ::
/? 310 :: arvo version
/- *oct3 :: structures
:: :: ::
:::: :::::: semantics
!: :: ::
|% ::
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ bit |=(@ =(1 (cut 0 [+< 1] bud))) :: moved at address
++ get |=(point (bit (off +<))) :: get point
++ jon a/(turn (gulf 0 9) |=(@ b/(bit +<))) :: to json
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: play from
|_ [src=ship game] ::
++ at |_ point :: per point
++ g `game`+>+<+ :: game
++ k &(!|(x o) ept) :: legal move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<), q.sag `src) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<), p.sag `src) :: play at x
-- ::
++ ept =+(own |(&(=(~ -) !=(oth `src)) =(`src -))) :: we can play
++ hey |=(? +>+<+(aud ((stat ship) +< src aud))) :: enter/leave
++ muy |= (list ship) ?~ +< +>+<+ :: many in audience
$(+< t.+<, aud ((stat ship) & i.+< aud)) ::
++ nam =+ ?: =(p.sag `src) ['=' (icon &) ~] :: print name
?: =(q.sag `src) ['=' (icon |) ~] ::
"" (welp (scow %p src) `tape`-) ::
++ new +<+(boo 0, box 0, who &, sag [~ ~]) :: reset game
++ oth own(who !who) :: who owns other turn
++ own ?:(who p.sag q.sag) :: who owns this turn
++ res ?. |(~(win bo box) ~(win bo boo)) :: possible result
?: =(511 (con boo box)) ::
`"tie :-(" ~ `"{<nam>} wins" ::
++ row |= y=@ :- (add y '1') %- zing :: print row
(turn (gulf 0 3) |=(@ ~[' ' ~(v at y +<)])) ::
++ str =+ [own ~[(icon who)]] ^- tape :: print player
?~(-< -> (scow %p u.-<)) ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
++ vew =- ?: =(~ -) ~ :(weld "[" - "]") :: print watchers
=+ dow=(~(tap by aud)) |- ^- tape ::
?~ dow ~ =+ mor=$(dow t.dow) ::
:(weld nam(src p.i.dow) ?~(mor "" ", ") mor) ::
++ voy =+ ~[(icon who)] %+ weld vew :: print prompt
?.(ept " ({-}'s turn) " ": {-} (row/col): ")::
--
--

59
base/lib/oct4.hoon Normal file
View File

@ -0,0 +1,59 @@
:: :: ::
:::: /hoon/oct4/lib :: :: dependencies
:: :: ::
/? 310 :: arvo version
/- *oct4 :: structures
:: :: ::
:::: :: :: semantics
!: :: ::
|%
++ icon |=(? ?:(+< 'X' 'O')) :: display at
++ bo :: per board
|_ bud=board ::
++ bit |=(@ =(1 (cut 0 [+< 1] bud))) :: moved at address
++ get |=(point (bit (off +<))) :: get point
++ jon a/(turn (gulf 0 9) |=(@ b/(bit +<))) :: to json
++ off |=(point (add x (mul 3 y))) :: bitfield address
++ set |=(point (con bud (bex (off +<)))) :: set point
++ win %- lien :_ |=(a=@ =(a (dis a bud))) :: test for win
(rip 4 0wl04h0.4A0Aw.4A00s.0e070) :: with bitmasks
-- ::
++ go :: play from
|_ [src=ship game] ::
++ at |_ point :: per point
++ g `game`+>+<+ :: game
++ k &(!|(x o) ept) :: legal move
++ m ?.(k [| g] [& g:t:?:(who y p)]) :: move
++ o (~(get bo boo) +<) :: old at o
++ p .(boo (~(set bo boo) +<), q.sag `src) :: play at o
++ t .(who !who) :: take turn
++ v ?:(x (icon &) ?:(o (icon |) '.')) :: view
++ x (~(get bo box) +<) :: old at x
++ y .(box (~(set bo box) +<), p.sag `src) :: play at x
-- ::
++ ept =+(own |(&(=(~ -) !=(oth `src)) =(`src -))) :: we can play
++ hey |=(? +>+<+(aud ((stat ship) +< src aud))) :: enter/leave
++ muy |= (list ship) ?~ +< +>+<+ :: many in audience
$(+< t.+<, aud ((stat ship) & i.+< aud)) ::
++ nam =+ ?: =(p.sag `src) ['=' (icon &) ~] :: print name
?: =(q.sag `src) ['=' (icon |) ~] ::
"" (welp (scow %p src) `tape`-) ::
++ new +<+(boo 0, box 0, who &, sag [~ ~]) :: reset game
++ oth own(who !who) :: who owns other turn
++ own ?:(who p.sag q.sag) :: who owns this turn
++ res ?. |(~(win bo box) ~(win bo boo)) :: possible result
?: =(511 (con boo box)) ::
`"tie :-(" ~ `"{<nam>} wins" ::
++ row |= y=@ :- (add y '1') %- zing :: print row
(turn (gulf 0 3) |=(@ ~[' ' ~(v at y +<)])) ::
++ str =+ [own ~[(icon who)]] ^- tape :: print player
?~(-< -> (scow %p u.-<)) ::
++ tab ~["+ 1 2 3" (row 0) (row 1) (row 2)] :: print table
++ vew =- ?: =(~ -) ~ :(weld "[" - "]") :: print watchers
=+ dow=(~(tap by aud)) |- ^- tape ::
?~ dow ~ =+ mor=$(dow t.dow) ::
:(weld nam(src p.i.dow) ?~(mor "" ", ") mor) ::
++ voy =+ ~[(icon who)] %+ weld vew :: print prompt
?.(ept " ({-}'s turn) " ": {-} (row/col): ")::
--
--

0
base/lib/react/core.hook → base/lib/react.hoon
View File

2
base/lib/sh-utils/core.hook → base/lib/sh-utils.hoon
View File

@ -1,6 +1,6 @@
:: App construction utilities
::
:::: /hook/core/sh-utils/lib
:::: /hoon/sh-utils/lib
::
|%
++ append

0
base/lib/shu/core.hook → base/lib/shu.hoon
View File

2
base/lib/sole/core.hook → base/lib/sole.hoon
View File

@ -1,5 +1,5 @@
::
:::: /hook/core/sole/lib
:::: /hoon/sole/lib
::
/? 310
/- *sole

43
base/lib/sqar/core.hook
View File

@ -1,43 +0,0 @@
~% %util +> ~
|%
++ kids (list inline)
++ inline
=+ ^= inlik
$% [%emph p=?] :: strong?
[%delt ~] :: strikethrough
[%link p=tape q=(unit tape)]
[%blot p=tape q=(unit tape)] :: image
==
=+ ^= inlin
$% [%$ p=tape]
[%line ~]
[%code p=tape]
[%html p=cord]
==
$&([p=inlik q=kids] inlin)
::
::
++ elem $&(tops node)
++ tops :: childful block
$: $= p
$% [%bloq ~]
[%list p=? q=$|(char [p=@u q=char])] :: tight, ordered?
[%item ~]
==
q=(list elem)
==
:: ++ mist |*(a=_,* ,[i=a t=$|(~ (mist a))]) :: .=(%mist +(%list))
++ node :: childless block
$% [%para p=kids]
[%hrul ~]
[%head p=@u q=kids]
[%code p=(unit ,[p=char q=@u r=tape]) q=wain] :: info, contents
[%html p=wain]
[%defn ~] :: empty para
==
::
++ sqar
~/ %sqar
|= @t
*(list elem)
--

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