mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-14 17:41:33 +03:00
1597 lines
50 KiB
Plaintext
1597 lines
50 KiB
Plaintext
:: :: ::
|
|
:::: /hoon/dojo/app :: ::::
|
|
:: :: ::
|
|
/? 309 :: arvo kelvin
|
|
/- *sole, lens :: console structures
|
|
/+ sole, pprint, ::
|
|
auto=language-server-complete, ::
|
|
easy-print=language-server-easy-print ::
|
|
:: :: ::
|
|
:::: :: ::::
|
|
:: :: ::
|
|
=> |% :: external structures
|
|
++ id @tasession :: session id
|
|
++ house :: all state
|
|
$: $6
|
|
egg/@u :: command count
|
|
hoc/(map id session) :: conversations
|
|
acl/(set ship) :: remote access whitelist
|
|
== ::
|
|
++ session :: per conversation
|
|
$: say/sole-share :: command-line state
|
|
dir/beam :: active path
|
|
poy/(unit dojo-project) :: working
|
|
$: :: sur: structure imports
|
|
::
|
|
sur=(list cable:clay)
|
|
:: lib: library imports
|
|
::
|
|
lib=(list cable:clay)
|
|
==
|
|
var/(map term cage) :: variable state
|
|
old/(set term) :: used TLVs
|
|
buf/tape :: multiline buffer
|
|
== ::
|
|
++ monkey :: per conversation
|
|
$: say/sole-share :: command-line state
|
|
dir/beam :: active path
|
|
poy/(unit dojo-project) :: working
|
|
var/(map term cage) :: variable state
|
|
old/(set term) :: used TLVs
|
|
buf/tape :: multiline buffer
|
|
== ::
|
|
++ dojo-command ::
|
|
$^ (pair dojo-sink dojo-source) :: route value
|
|
{$brev p/term} :: unbind variable
|
|
::
|
|
++ dojo-sink ::
|
|
$% {$flat p/path} :: atom to unix
|
|
{$pill p/path} :: noun to unix pill
|
|
:: {$tree p/path} :: noun to unix tree
|
|
{$file p/beam} :: save to clay
|
|
$: $http :: http outbound
|
|
p/?($post $put)
|
|
r/@t
|
|
==
|
|
{$poke p/goal} :: poke app
|
|
{$show p/?($0 $1 $2 $3 $4 $5)} :: val/type/hoon/xray
|
|
{$verb p/term} :: store variable
|
|
== ::
|
|
++ dojo-source :: construction node
|
|
$: p/@ud :: assembly index
|
|
q/dojo-build :: general build
|
|
== ::
|
|
++ dojo-build :: one arvo step
|
|
$~ [%ex *hoon]
|
|
$% {$ur p/@t} :: http GET request
|
|
{$ge p/dojo-model} :: generator
|
|
{$te p/term q/(list dojo-source)} :: thread
|
|
{$dv p/path} :: core from source
|
|
{$ex p/hoon} :: hoon expression
|
|
{$sa p/mark} :: example mark value
|
|
{$as p/mark q/dojo-source} :: simple transmute
|
|
{$do p/hoon q/dojo-source} :: gate apply
|
|
{$tu p/(list dojo-source)} :: tuple
|
|
== ::
|
|
++ dojo-model :: data construction
|
|
$: p/dojo-server :: core source
|
|
q/dojo-config :: configuration
|
|
== ::
|
|
++ dojo-server :: numbered device
|
|
$: p/@ud :: assembly index
|
|
q/path :: gate path
|
|
== ::
|
|
++ dojo-config :: configuration
|
|
$: p/(list dojo-source) :: by order
|
|
q/(map term (unit dojo-source)) :: by keyword
|
|
== ::
|
|
++ dojo-project :: construction state
|
|
$: mad/dojo-command :: operation
|
|
num/@ud :: number of tasks
|
|
cud/(unit dojo-source) :: now solving
|
|
pux/(unit path) :: working
|
|
pro/(unit vase) :: prompting loop
|
|
per/(unit sole-edit) :: pending reverse
|
|
job/(map @ud dojo-build) :: problems
|
|
rez/(map @ud cage) :: results
|
|
== ::
|
|
++ bead {p/(set beam) q/cage} :: computed result
|
|
++ goal {p/ship q/term} :: flat application
|
|
--
|
|
=>
|
|
|%
|
|
:: TODO: move to zuse? copied from clay
|
|
::
|
|
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
|
|
++ with-faces
|
|
=| res=(unit vase)
|
|
|= vaz=(list [face=@tas =vase])
|
|
^- vase
|
|
?~ vaz (need res)
|
|
=/ faz (with-face i.vaz)
|
|
=. res `?~(res faz (slop faz u.res))
|
|
$(vaz t.vaz)
|
|
:: |parser-at: parsers for dojo expressions using :dir as working directory
|
|
::
|
|
++ parser-at
|
|
|= [our=ship dir=beam]
|
|
|%
|
|
++ default-app %hood
|
|
++ hoon-parser (vang | (en-beam:format dir))
|
|
++ our p.dir
|
|
::
|
|
++ parse-command-line ;~(sfix parse-command (star ace) (just '\0a'))
|
|
::
|
|
++ to-command
|
|
|= [gol=goal mod=dojo-model]
|
|
^- dojo-command
|
|
[[%poke gol] [0 [%ge mod(q.p [q.gol q.p.mod])]]]
|
|
::
|
|
++ parse-variable
|
|
|* [sym=rule src=rule]
|
|
%+ cook
|
|
|= {a/term b/(unit dojo-source)}
|
|
^- dojo-command
|
|
?~(b [%brev a] [[%verb a] u.b])
|
|
;~(plug sym (punt src))
|
|
::
|
|
++ parse-command
|
|
:: =< ;~(less |-(;~(pose (jest '|*') ;~(pfix next (knee ** |.(^$))))) .)
|
|
%+ knee *dojo-command |. ~+
|
|
;~ pose
|
|
;~ pfix bar
|
|
%+ cook to-command
|
|
(stag `goal`[our default-app] parse-model)
|
|
==
|
|
::
|
|
;~ pfix col
|
|
%+ cook
|
|
|= {a/goal b/$^(dojo-model dojo-source)}
|
|
?@ -.b [[%poke a] b]
|
|
(to-command a b)
|
|
;~ plug
|
|
parse-goal
|
|
;~ pose
|
|
;~(pfix bar parse-model)
|
|
;~(pfix ace parse-source)
|
|
==
|
|
==
|
|
==
|
|
::
|
|
;~ pfix tis
|
|
;~ pose
|
|
(parse-variable (jest %dir) ;~(pfix ace :(stag 0 %ex parse-rood)))
|
|
(parse-variable sym ;~(pfix ace parse-source))
|
|
==
|
|
==
|
|
::
|
|
;~ pfix fas
|
|
;~ pose
|
|
(parse-variable (cold %sur hep) ;~(pfix gap parse-cables))
|
|
(parse-variable (cold %lib lus) ;~(pfix gap parse-cables))
|
|
==
|
|
==
|
|
::
|
|
;~((glue ace) parse-sink parse-source)
|
|
(stag [%show %0] parse-source)
|
|
==
|
|
::
|
|
++ parse-sink
|
|
;~ pose
|
|
;~(plug (cold %file tar) parse-beam)
|
|
;~(plug (cold %flat pat) (most fas sym))
|
|
;~(plug (cold %pill dot) (most fas sym))
|
|
;~(plug (cold %http lus) (stag %post parse-url))
|
|
;~(plug (cold %http hep) (stag %put parse-url))
|
|
(stag %show (cook $?($1 $2 $3 $4 $5) (cook lent (stun [1 5] wut))))
|
|
==
|
|
::
|
|
++ parse-cables
|
|
%+ cook
|
|
|= cables=(list cable:clay)
|
|
:+ 0 %ex
|
|
^- hoon
|
|
::
|
|
:- %clsg
|
|
%+ turn cables
|
|
|= cable=cable:clay
|
|
^- hoon
|
|
::
|
|
:+ %clhp
|
|
?~ face.cable
|
|
[%rock %n ~]
|
|
[%clhp [%rock %n ~] [%sand %tas u.face.cable]]
|
|
[%sand %tas file-path.cable]
|
|
(most ;~(plug com gaw) parse-cable)
|
|
::
|
|
++ parse-cable
|
|
%+ cook |=(a=cable:clay a)
|
|
;~ pose
|
|
(stag ~ ;~(pfix tar sym))
|
|
(cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym))
|
|
(cook |=(a=term [`a a]) sym)
|
|
==
|
|
++ parse-source (stag 0 parse-build)
|
|
++ parse-build
|
|
%+ knee *dojo-build |. ~+
|
|
;~ pose
|
|
;~(plug (cold %ur lus) parse-url)
|
|
;~(plug (cold %ge lus) parse-model)
|
|
;~(plug (cold %te hep) sym (star ;~(pfix ace parse-source)))
|
|
;~(plug (cold %as pam) sym ;~(pfix ace parse-source))
|
|
;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source))
|
|
parse-value
|
|
==
|
|
::
|
|
++ parse-goal
|
|
%+ cook |=(a/goal a)
|
|
;~ pose
|
|
;~ plug
|
|
;~(pfix sig fed:ag)
|
|
;~(pose ;~(pfix fas sym) (easy default-app))
|
|
==
|
|
%+ stag our
|
|
;~(pose sym (easy default-app))
|
|
==
|
|
::
|
|
++ parse-beam
|
|
%+ cook
|
|
|= a=path
|
|
:: hack: fixup paths that come out of the hoon parser
|
|
::
|
|
:: We currently invoke the hoon parser to read relative paths from
|
|
:: the command line, and this parser will produce leading ~ path
|
|
:: components with paths that start with a `/`.
|
|
::
|
|
:: This entire path is nuts and we shouldn't be representing paths
|
|
:: as arbitrary hoons.
|
|
::
|
|
=? a &(?=(^ a) =('' i.a))
|
|
t.a
|
|
(fall (de-beam:format a) [`beak`[p q r]:dir (flop a)])
|
|
=+ vez=hoon-parser
|
|
(sear plex:vez (stag %clsg poor:vez))
|
|
::
|
|
++ parse-iden-url
|
|
%+ cook
|
|
|=([a=(unit knot) b=purl:eyre] [`(fall a *knot) b])
|
|
auru:de-purl:html
|
|
::
|
|
++ parse-url
|
|
%+ cook
|
|
|=(a=purl:eyre (crip (en-purl:html a)))
|
|
auri:de-purl:html
|
|
::
|
|
++ parse-model ;~(plug parse-server parse-config)
|
|
++ parse-server (stag 0 (most fas sym))
|
|
++ parse-hoon tall:hoon-parser
|
|
::
|
|
++ parse-rood
|
|
:: XX should this use +hoon-parser instead to normalize the case?
|
|
::
|
|
=> (vang | (en-beam:format dir))
|
|
;~ pose
|
|
rood
|
|
::
|
|
:: XX refactor ++scat
|
|
::
|
|
=- ;~(pfix cen (stag %clsg -))
|
|
%+ sear |=([a=@ud b=tyke] (posh ~ ~ a b))
|
|
;~ pose
|
|
porc
|
|
(cook |=(a=(list) [(lent a) ~]) (star cen))
|
|
==
|
|
==
|
|
++ parse-value
|
|
;~ pose
|
|
;~(plug (cold %as pam) sym ;~(pfix ace parse-source))
|
|
(stag %sa ;~(pfix tar pam sym))
|
|
(stag %ex parse-hoon)
|
|
(stag %tu (ifix [sel ser] (most ace parse-source)))
|
|
==
|
|
::
|
|
++ parse-config
|
|
;~ plug
|
|
(star ;~(pfix ace (stag 0 parse-value)))
|
|
%+ cook
|
|
~(gas by *(map term (unit dojo-source)))
|
|
%- star
|
|
;~ plug
|
|
;~(pfix com ace tis sym)
|
|
(punt ;~(pfix ace (stag 0 parse-value)))
|
|
==
|
|
==
|
|
--
|
|
--
|
|
:: ::
|
|
:::: ::
|
|
:: ::
|
|
=, gall
|
|
=+ foo=*monkey
|
|
=| house :: program state
|
|
=* state -
|
|
=> |%
|
|
::
|
|
++ xskol `$-(type tank)`type-to-tank:pprint
|
|
++ xsell `$-(vase tank)`vase-to-tank:pprint
|
|
::
|
|
++ he :: per session
|
|
|_ {hid/bowl:gall =id moz/(list card:agent:gall) session}
|
|
::
|
|
++ he-beam
|
|
^- beam
|
|
?. =([%ud 0] r.dir)
|
|
dir
|
|
dir(r [%da now.hid])
|
|
::
|
|
++ he-beak `beak`[p q r]:he-beam
|
|
++ he-parser (parser-at our.hid he-beam)
|
|
::
|
|
++ dy :: project work
|
|
|_ dojo-project ::
|
|
++ dy-abet +>(poy `+<) :: resolve
|
|
++ dy-amok +>(poy ~) :: terminate
|
|
:: +dy-sing: make a clay read request
|
|
::
|
|
++ dy-sing
|
|
|= [way=wire =care:clay =path]
|
|
^+ +>+>
|
|
?> ?=(~ pux)
|
|
%- he-card(poy `+>+<(pux `way))
|
|
=/ [=ship =desk =case:clay] he-beak
|
|
[%pass way %arvo %c %warp ship desk ~ %sing care case path]
|
|
::
|
|
++ dy-request
|
|
|= [way=wire =request:http]
|
|
^+ +>+>
|
|
?> ?=(~ pux)
|
|
%- he-card(poy `+>+<(pux `way))
|
|
[%pass way %arvo %i %request request *outbound-config:iris]
|
|
::
|
|
++ dy-stop :: stop work
|
|
^+ +>
|
|
=. poy ~
|
|
?~ pux +>
|
|
%. [%txt "! cancel {<u.pux>}"]
|
|
=< he-diff
|
|
%- he-card
|
|
?: =(/wool u.pux)
|
|
:: really shoud stop the thread as well
|
|
::
|
|
[%pass u.pux %agent [our.hid %spider] %leave ~]
|
|
=/ [=ship =desk =case:clay] he-beak
|
|
[%pass u.pux %arvo %c %warp ship desk ~]
|
|
::
|
|
++ dy-errd :: reject change, abet
|
|
|= {rev/(unit sole-edit) err/@u}
|
|
^+ +>+>
|
|
(he-errd(poy `+>+<) rev err)
|
|
::
|
|
++ dy-diff :: send effects, abet
|
|
|= fec/sole-effect
|
|
^+ +>+>
|
|
(he-diff(poy `+>+<) fec)
|
|
::
|
|
++ dy-rash :: send effects, amok
|
|
|= fec/sole-effect
|
|
^+ +>+>
|
|
(he-diff(poy ~) fec)
|
|
::
|
|
++ dy-init-command :: ++dojo-command
|
|
|= mad/dojo-command
|
|
^+ [mad +>]
|
|
?@ -.mad [mad +>.$]
|
|
=. q.mad
|
|
?+(-.p.mad q.mad $http [0 %as %mime q.mad])
|
|
=^ src +>.$ (dy-init-source q.mad)
|
|
[mad(q src) +>.$]
|
|
::
|
|
++ dy-init-source :: ++dojo-source
|
|
|= src/dojo-source
|
|
^+ [src +>]
|
|
=^ bul +> (dy-init-build q.src)
|
|
=: p.src num
|
|
q.src bul
|
|
==
|
|
[src +>.$(num +(num), job (~(put by job) -.src +.src))]
|
|
::
|
|
++ dy-init-source-unit :: (unit dojo-source)
|
|
|= urc/(unit dojo-source)
|
|
^+ [urc +>]
|
|
?~ urc [~ +>]
|
|
=^ src +> (dy-init-source u.urc)
|
|
[`src +>.$]
|
|
::
|
|
++ dy-init-build :: ++dojo-build
|
|
|= bul/dojo-build
|
|
^+ [bul +>]
|
|
?- -.bul
|
|
$ex [bul +>.$]
|
|
$dv [bul +>.$]
|
|
$sa [bul +>.$]
|
|
$as =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
|
|
$do =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
|
|
$ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
|
|
$te =^(mod +>.$ (dy-init-ordered q.bul) [bul(q mod) +>.$])
|
|
$ur [bul +>.$]
|
|
$tu =^(dof +>.$ (dy-init-ordered p.bul) [[%tu dof] +>.$])
|
|
==
|
|
::
|
|
++ dy-init-model :: ++dojo-model
|
|
|= mol/dojo-model
|
|
^+ [mol +>]
|
|
=^ one +>.$ (dy-init-server p.mol)
|
|
=^ two +>.$ (dy-init-config q.mol)
|
|
[[one two] +>.$]
|
|
::
|
|
++ dy-init-server :: ++dojo-server
|
|
|= srv/dojo-server
|
|
=. p.srv num
|
|
[srv +>.$(num +(num), job (~(put by job) num [%dv [%gen q.srv]]))]
|
|
::
|
|
++ dy-init-config :: prepare config
|
|
|= cig/dojo-config
|
|
^+ [cig +>]
|
|
=^ ord +>.$ (dy-init-ordered p.cig)
|
|
=^ key +>.$ (dy-init-named q.cig)
|
|
[[ord key] +>.$]
|
|
::
|
|
++ dy-init-ordered :: (list dojo-source)
|
|
|= ord/(list dojo-source)
|
|
^+ [ord +>]
|
|
?~ ord [~ +>.$]
|
|
=^ fir +>.$ (dy-init-source i.ord)
|
|
=^ mor +>.$ $(ord t.ord)
|
|
[[fir mor] +>.$]
|
|
::
|
|
++ dy-init-named :: (map @tas dojo-src)
|
|
|= key/(map term (unit dojo-source))
|
|
^+ [key +>.$]
|
|
?~ key [~ +>.$]
|
|
=^ top +>.$ (dy-init-source-unit q.n.key)
|
|
=^ lef +>.$ $(key l.key)
|
|
=^ rit +>.$ $(key r.key)
|
|
[[[p.n.key top] lef rit] +>.$]
|
|
::
|
|
++ dy-init :: full initialize
|
|
^+ .
|
|
=^(dam . (dy-init-command mad) +(mad dam))
|
|
::
|
|
++ dy-hand :: complete step
|
|
|= cag/cage
|
|
^+ +>+>
|
|
?> ?=(^ cud)
|
|
(dy-step(cud ~, rez (~(put by rez) p.u.cud cag)) +(p.u.cud))
|
|
::
|
|
++ dy-meal :: vase to cage
|
|
|= vax/vase
|
|
?. &(?=(@ -.q.vax) ((sane %tas) -.q.vax))
|
|
~& %dy-meal-cage
|
|
(dy-rash %bel ~)
|
|
(dy-hand -.q.vax (slot 3 vax))
|
|
::
|
|
++ dy-made-edit :: sole edit
|
|
|= cag/cage
|
|
^+ +>+>
|
|
?> ?=(^ per)
|
|
?: ?| ?=(^ q.q.cag)
|
|
=((lent buf.say) q.q.cag)
|
|
!&(?=($del -.u.per) =(+(p.u.per) (lent buf.say)))
|
|
==
|
|
dy-abet(per ~)
|
|
(dy-errd(per ~) per q.q.cag)
|
|
::
|
|
++ dy-done :: dialog submit
|
|
|= txt/tape
|
|
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
|
|
~& %dy-no-prompt
|
|
(dy-diff %bel ~)
|
|
=/ res (mule |.((slam u.pro !>(txt))))
|
|
?: ?=(%| -.res)
|
|
%- (slog >%dy-done< p.res)
|
|
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
|
|
(dy-made-dial %noun p.res)
|
|
::
|
|
++ dy-cast
|
|
|* {typ/_* bun/vase}
|
|
|= a/vase ^- typ
|
|
~| [p.bun p.a]
|
|
?> (~(nest ut p.bun) & p.a)
|
|
;;(typ q.a)
|
|
::
|
|
++ dy-over :: finish construction
|
|
^+ +>
|
|
:: XX needs filter
|
|
::
|
|
?: ?=({$show $3} -.mad)
|
|
(dy-rash %tan (dy-show-source q.mad) ~)
|
|
?: ?=($brev -.mad)
|
|
=. var (~(del by var) p.mad)
|
|
=< dy-amok
|
|
?+ p.mad .
|
|
$?($eny $now $our) !!
|
|
$lib .(lib ~)
|
|
$sur .(sur ~)
|
|
$dir .(dir [[our.hid %home ud+0] /])
|
|
==
|
|
=+ cay=(~(got by rez) p.q.mad)
|
|
?- -.p.mad
|
|
$verb
|
|
=. var (~(put by var) p.p.mad cay)
|
|
~| bad-set+[p.p.mad p.q.cay]
|
|
=< dy-amok
|
|
?+ p.p.mad .
|
|
$eny ~|(%entropy-is-eternal !!)
|
|
$now ~|(%time-is-immutable !!)
|
|
$our ~|(%self-is-immutable !!)
|
|
$lib
|
|
%_ .
|
|
lib
|
|
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
|
|
==
|
|
::
|
|
$sur
|
|
%_ .
|
|
sur
|
|
((dy-cast (list cable:clay) !>(*(list cable:clay))) q.cay)
|
|
==
|
|
::
|
|
$dir =+ ^= pax ^- path
|
|
=+ pax=((dy-cast path !>(*path)) q.cay)
|
|
?: ?=(~ pax) ~[(scot %p our.hid) %home '0']
|
|
?: ?=({@ ~} pax) ~[i.pax %home '0']
|
|
?: ?=({@ @ ~} pax) ~[i.pax i.t.pax '0']
|
|
pax
|
|
=. dir (need (de-beam:format pax))
|
|
=- +>(..dy (he-diff %tan - ~))
|
|
rose+[" " `~]^~[leaf+"=%" (smyt (en-beam:format he-beak s.dir))]
|
|
==
|
|
::
|
|
$poke
|
|
%- he-card(poy ~)
|
|
:* %pass
|
|
/poke
|
|
%agent
|
|
p.p.mad
|
|
%poke
|
|
cay
|
|
==
|
|
::
|
|
$file
|
|
%- he-card(poy ~)
|
|
:* %pass /file %arvo %c
|
|
%info (foal:space:userlib (en-beam:format p.p.mad) cay)
|
|
==
|
|
::
|
|
$flat
|
|
?^ q.q.cay
|
|
(dy-rash %tan [%leaf "not an atom"]~)
|
|
(dy-rash %sav p.p.mad q.q.cay)
|
|
::
|
|
$pill
|
|
(dy-rash %sag p.p.mad q.q.cay)
|
|
::
|
|
$http
|
|
?> ?=($mime p.cay)
|
|
=+ mim=;;(mime q.q.cay)
|
|
%+ dy-request /show
|
|
:* ?:(=(%put p.p.mad) %'PUT' %'POST')
|
|
r.p.mad
|
|
~[['content-type' (en-mite:mimes:html p.mim)]]
|
|
`q.mim
|
|
==
|
|
::
|
|
$show
|
|
|^ (prnt cay note)
|
|
++ prnt ?: (gte p.p.mad 4)
|
|
dy-xprint
|
|
dy-print
|
|
++ note ^- tang
|
|
?- p.p.mad
|
|
%0 ~
|
|
%1 [[%rose [~ " " ~] (skol p.q.cay) ~] maar]
|
|
%2 [[%rose [~ " " ~] (dy-show-type-noun p.q.cay) ~] maar]
|
|
::%3 handled above
|
|
%4 ~
|
|
%5 [[%rose [~ " " ~] (xskol p.q.cay) ~] maar]
|
|
==
|
|
++ maar ?: =(%noun p.cay) ~
|
|
[[%rose [~ " " ~] >p.cay< ~] ~]
|
|
--
|
|
==
|
|
::
|
|
++ dy-show |=(cay/cage (dy-print cay ~))
|
|
::
|
|
:: Print a value (given as a cage) and a note (given as a tang).
|
|
::
|
|
++ dy-xprint
|
|
|= {cay/cage tan/tang}
|
|
%+ dy-rash %tan
|
|
%- welp :_ tan
|
|
?+ p.cay [(xsell q.cay)]~
|
|
$tang ;;(tang q.q.cay)
|
|
$httr
|
|
=+ hit=;;(httr:eyre q.q.cay)
|
|
=- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '' ~))))
|
|
:- "HTTP {<p.hit>}"
|
|
%+ weld
|
|
(turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}"))
|
|
:- i=""
|
|
t=(turn `wain`?~(r.hit ~ (to-wain:format q.u.r.hit)) trip)
|
|
==
|
|
::
|
|
:: Print a value (given as a cage) and a note (given as a tang).
|
|
::
|
|
++ dy-print
|
|
|= {cay/cage tan/tang}
|
|
%+ dy-rash %tan
|
|
%- welp :_ tan
|
|
?+ p.cay [(sell q.cay)]~
|
|
$tang ;;(tang q.q.cay)
|
|
$httr
|
|
=+ hit=;;(httr:eyre q.q.cay)
|
|
=- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '' ~))))
|
|
:- "HTTP {<p.hit>}"
|
|
%+ weld
|
|
(turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}"))
|
|
:- i=""
|
|
t=(turn `wain`?~(r.hit ~ (to-wain:format q.u.r.hit)) trip)
|
|
==
|
|
++ dy-show-type-noun
|
|
|= a/type ^- tank
|
|
=- >[-]<
|
|
|- ^- $? $% {$atom @tas (unit @)}
|
|
{$cell _$ _$}
|
|
{$face $@(term tune) _$}
|
|
{$fork (set _$)}
|
|
{$hold _$ hoon}
|
|
==
|
|
wain :: "<|core|>"
|
|
$?($noun $void)
|
|
==
|
|
?+ a a
|
|
{$face ^} a(q $(a q.a))
|
|
{$cell ^} a(p $(a p.a), q $(a q.a))
|
|
{$fork *} a(p (silt (turn ~(tap in p.a) |=(b/type ^$(a b)))))
|
|
{$hint *} !!
|
|
{$core ^} `wain`/core
|
|
{$hold *} a(p $(a p.a))
|
|
==
|
|
::
|
|
:: XX needs filter
|
|
::
|
|
++ dy-shown
|
|
=/ jank-bucwut :: FIXME just $? fishes when defined for some reason
|
|
|* [a=mold b=mold]
|
|
|=(c=_`*`*a ?:(& (a c) (b c)))
|
|
::
|
|
::$? hoon
|
|
;: jank-bucwut
|
|
hoon
|
|
$^ {dy-shown dy-shown}
|
|
$% {$ur cord}
|
|
{$sa mark}
|
|
{$as mark dy-shown}
|
|
{$do hoon dy-shown}
|
|
{$te term (list dy-shown)}
|
|
{$ge path (list dy-shown) (map term (unit dy-shown))}
|
|
{$dv path}
|
|
==
|
|
==
|
|
::
|
|
++ dy-show-source
|
|
|= a/dojo-source ^- tank
|
|
=- >[-]<
|
|
=+ `{@ bil/dojo-build}`a
|
|
|- ^- dy-shown
|
|
?- -.bil
|
|
$?($ur $dv $sa) bil
|
|
$ex ?. ?=({$cltr *} p.bil) p.bil
|
|
|- ^- hoon
|
|
?~ p.p.bil !!
|
|
?~ t.p.p.bil i.p.p.bil
|
|
[i.p.p.bil $(p.p.bil t.p.p.bil)]
|
|
$tu ?~ p.bil !!
|
|
|-
|
|
?~ t.p.bil ^$(bil q.i.p.bil)
|
|
[^$(bil q.i.p.bil) $(p.bil t.p.bil)]
|
|
$as bil(q $(bil q.q.bil))
|
|
$do bil(q $(bil q.q.bil))
|
|
$te bil(q (turn q.bil ..$))
|
|
$ge :+ %ge q.p.p.bil
|
|
[(turn p.q.p.bil ..$) (~(run by q.q.p.bil) (lift ..$))]
|
|
==
|
|
::
|
|
++ dy-edit :: handle edit
|
|
|= cal/sole-change
|
|
^+ +>+>
|
|
=^ dat say (~(transceive sole say) cal)
|
|
?: |(?=(^ per) ?=(^ pux) ?=(~ pro))
|
|
~& %dy-edit-busy
|
|
=^ lic say (~(transmit sole say) dat)
|
|
(dy-diff %mor [%det lic] [%bel ~] ~)
|
|
=> .(per `dat)
|
|
=/ res (mule |.((slam u.pro !>((tufa buf.say)))))
|
|
?: ?=(%| -.res)
|
|
%- (slog >%dy-edit< p.res)
|
|
(dy-rash %bel ~) :: TODO: or +dy-abet(per ~) ?
|
|
(dy-made-edit %noun p.res)
|
|
::
|
|
++ dy-type :: sole action
|
|
|= act/sole-action
|
|
?- -.dat.act
|
|
$det (dy-edit +.dat.act)
|
|
$ret (dy-done (tufa buf.say))
|
|
$clr dy-stop
|
|
$tab +>+>
|
|
==
|
|
::
|
|
++ dy-cage |=(num/@ud (~(got by rez) num)) :: known cage
|
|
++ dy-vase |=(num/@ud q:(dy-cage num)) :: known vase
|
|
++ dy-sore
|
|
|= src/(list dojo-source)
|
|
^- vase
|
|
?~ src
|
|
!>(~)
|
|
(slop (dy-vase p.i.src) $(src t.src))
|
|
::
|
|
++ dy-run-generator
|
|
!.
|
|
|= [cay=cage cig=dojo-config]
|
|
^+ +>+>
|
|
?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay)
|
|
:: naked generator; takes one argument
|
|
::
|
|
?. &(?=({* ~} p.cig) ?=(~ q.cig))
|
|
~|(%one-argument !!)
|
|
=/ res (mule |.((slam q.cay (dy-vase p.i.p.cig))))
|
|
?: ?=(%| -.res)
|
|
:: TODO: or +dy-rash ?
|
|
(he-diff(poy ~) %tan leaf+"dojo: naked generator failure" p.res)
|
|
(dy-hand %noun p.res)
|
|
:: normal generator
|
|
::
|
|
:: A normal generator takes as arguments:
|
|
:: - event args: date, entropy, beak (network location)
|
|
:: - positional arguments, as a list
|
|
:: - optional keyword arguments, as name-value pairs
|
|
::
|
|
:: The generator is a pair of a result mark and a gate.
|
|
:: TODO: test %ask generators
|
|
::
|
|
=/ wat (mule |.(!<(?(%ask %say) (slot 2 q.cay))))
|
|
?: ?=(%| -.wat)
|
|
(he-diff(poy ~) %tan leaf+"dojo: generator neither %ask nor %say" p.wat)
|
|
=- =/ res (mule -)
|
|
?: ?=(%| -.res)
|
|
(he-diff(poy ~) %tan leaf+"dojo: generator failure" p.res)
|
|
?- p.wat
|
|
%ask (dy-made-dial %noun p.res)
|
|
%say (dy-made-gent %noun p.res)
|
|
==
|
|
:: gat: generator gate
|
|
:: som: default gat sample
|
|
:: ven: event arguments
|
|
:: poz: positional arguments
|
|
:: kev: key-value named arguments
|
|
:: kuv: default keyword arguments
|
|
:: sam: fully populated sample
|
|
:: rog: default gat sample
|
|
::
|
|
|. ^- vase
|
|
=/ gat=vase (slot 3 q.cay)
|
|
=/ som=vase (slot 6 gat)
|
|
=/ ven=vase !>([now=now.hid eny=eny.hid bec=he-beak])
|
|
=/ poz=vase (dy-sore p.cig)
|
|
=/ kev=vase
|
|
=/ kuv=(unit vase) (slew 7 som)
|
|
?: =(~ q.cig)
|
|
(fall kuv !>(~))
|
|
=/ soz=(list [var=term vax=vase])
|
|
%~ tap by
|
|
%- ~(run by q.cig)
|
|
|=(val=(unit dojo-source) ?~(val !>([~ ~]) (dy-vase p.u.val)))
|
|
~| keyword-arg-failure+~(key by q.cig)
|
|
%+ slap
|
|
(with-faces kuv+(need kuv) rep+(with-faces soz) ~)
|
|
:+ %cncb [%kuv]~
|
|
%+ turn soz
|
|
|= [var=term *]
|
|
^- [wing hoon]
|
|
[[var]~ [%wing var %rep ~]]
|
|
::
|
|
=/ sam=vase :(slop ven poz kev)
|
|
?. (~(nest ut p.som) | p.sam)
|
|
~> %slog.1^leaf+"dojo: nest-need"
|
|
~> %slog.0^(skol p.som)
|
|
~> %slog.1^leaf+"dojo: nest-have"
|
|
~> %slog.0^(skol p.sam)
|
|
!!
|
|
(slam gat sam)
|
|
::
|
|
++ dy-made-dial :: dialog product
|
|
|= cag/cage
|
|
^+ +>+>
|
|
?. ?=(^ q.q.cag)
|
|
(dy-errd ~ q.q.cag)
|
|
=+ tan=((list tank) +2.q.q.cag)
|
|
=. +>+>.$ (he-diff %tan tan)
|
|
=+ vax=(sped (slot 3 q.cag))
|
|
?+ -.q.vax !!
|
|
%&
|
|
?~ +.q.vax
|
|
~& %dy-made-dial-abort
|
|
(dy-rash %bel ~)
|
|
(dy-meal (slot 7 vax))
|
|
::
|
|
%|
|
|
=< he-pone
|
|
%- dy-diff(pro `(slap (slot 7 vax) [%limb %q]))
|
|
=+ pom=(sole-prompt +<.q.vax)
|
|
[%pro pom(cad [':' ' ' cad.pom])]
|
|
==
|
|
::
|
|
++ dy-made-gent :: generator product
|
|
|= cag/cage
|
|
(dy-meal q.cag)
|
|
::
|
|
++ dy-made-noun :: generator product
|
|
|= cag/cage
|
|
(dy-hand %noun q.cag)
|
|
::
|
|
++ dy-wool-poke
|
|
|= [fil=term src=(list dojo-source)]
|
|
^+ +>+>
|
|
?> ?=(~ pux)
|
|
=/ tid (scot %ta (cat 3 'dojo_' (scot %uv (sham eny.hid))))
|
|
=. poy `+>+<.$(pux `/wool)
|
|
=. +>+>.$
|
|
%- he-card
|
|
[%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]]
|
|
%- he-card
|
|
=/ =cage :: also sub
|
|
[%spider-start !>([~ `tid fil (dy-sore src)])]
|
|
[%pass /wool %agent [our.hid %spider] %poke cage]
|
|
::
|
|
++ dy-make :: build step
|
|
^+ +>
|
|
?> ?=(^ cud)
|
|
=/ bil q.u.cud
|
|
?- -.bil
|
|
%ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~])
|
|
%te (dy-wool-poke p.bil q.bil)
|
|
%ex (dy-mere p.bil)
|
|
%dv (dy-sing hand+p.bil %a (snoc p.bil %hoon))
|
|
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
|
|
%sa
|
|
=+ .^(=dais:clay cb+(en-beam:format he-beak /[p.bil]))
|
|
(dy-hand p.bil bunt:dais)
|
|
::
|
|
%as
|
|
=/ cag=cage (dy-cage p.q.bil)
|
|
=+ .^(=tube:clay cc+(en-beam:format he-beak /[p.bil]/[p.cag]))
|
|
(dy-hand p.bil (tube q.cag))
|
|
::
|
|
%do
|
|
=/ gat (dy-eval p.bil)
|
|
?: ?=(%| -.gat)
|
|
(he-diff(poy ~) %tan leaf+"dojo: %do create gate failed" p.gat)
|
|
=/ res (mule |.((slam q.p.gat (dy-vase p.q.bil))))
|
|
?: ?=(%| -.res)
|
|
(he-diff(poy ~) %tan leaf+"dojo: %do execute failed" p.res)
|
|
(dy-hand %noun p.res)
|
|
::
|
|
%tu
|
|
%+ dy-hand %noun
|
|
|- ^- vase
|
|
?~ p.bil !!
|
|
=/ hed (dy-vase p.i.p.bil)
|
|
?~ t.p.bil hed
|
|
(slop hed $(p.bil t.p.bil))
|
|
==
|
|
:: +dy-hoon-var: if input is a dojo variable lookup, perform it
|
|
::
|
|
:: If the expression is a bare reference to a Dojo variable,
|
|
:: produce that variable's value; otherwise, produce ~.
|
|
::
|
|
++ dy-hoon-var
|
|
=+ ^= ope
|
|
|= gen/hoon ^- hoon
|
|
?: ?=(?($sgld $sgbn) -.gen)
|
|
$(gen q.gen)
|
|
=+ ~(open ap gen)
|
|
?.(=(gen -) $(gen -) gen)
|
|
|= gen/hoon ^- (unit cage)
|
|
=. gen (ope gen)
|
|
?: ?=({$cnts {@ ~} ~} gen)
|
|
(~(get by var) i.p.gen)
|
|
~
|
|
:: +dy-mere: execute hoon and complete construction step
|
|
::
|
|
++ dy-mere
|
|
|= =hoon
|
|
=/ res (dy-eval hoon)
|
|
?: ?=(%| -.res)
|
|
(he-diff(poy ~) %tan leaf+"dojo: hoon expression failed" p.res)
|
|
(dy-hand p.res)
|
|
:: +dy-eval: run hoon source against the dojo subject
|
|
::
|
|
:: TODO: use /lib and /sur imports to construct subject
|
|
::
|
|
++ dy-eval
|
|
|= =hoon
|
|
^- (each cage tang)
|
|
?^ val=(dy-hoon-var hoon)
|
|
&+u.val
|
|
!.
|
|
%- mule |.
|
|
:- %noun
|
|
=/ vaz=(list [term vase])
|
|
(turn ~(tap by var) |=([lal=term cag=cage] [lal q.cag]))
|
|
=/ sut (slop !>([our=our now=now eny=eny]:hid) !>(..zuse))
|
|
=? sut ?=(^ vaz) (slop (with-faces vaz) sut)
|
|
(slap sut hoon)
|
|
::
|
|
++ dy-step :: advance project
|
|
|= nex/@ud
|
|
^+ +>+>
|
|
?> ?=(~ cud)
|
|
?: =(nex num)
|
|
dy-over
|
|
?: =([%show %3] -.mad) :: just show source
|
|
dy-over
|
|
dy-make(cud `[nex (~(got by job) nex)])
|
|
--
|
|
::
|
|
++ he-dope
|
|
|= txt/tape ::
|
|
^- (each (unit (each dojo-command tape)) hair) :: prefix+result
|
|
=+ len=+((lent txt)) :: line length
|
|
=. txt (weld buf `tape`(weld txt "\0a")) ::
|
|
=+ vex=((full parse-command-line:he-parser) [1 1] txt)
|
|
?: =(q.p.vex len) :: matched to line end
|
|
[%& ~] ::
|
|
?: =(p.p.vex +((lent (skim txt |=(a/@ =(10 a)))))) :: parsed all lines
|
|
[%& ~ ?~(q.vex [%| txt] [%& p.u.q.vex])] :: new buffer+complete
|
|
[%| p.p.vex (dec q.p.vex)] :: syntax error
|
|
::
|
|
++ he-duke :: ++he-dope variant
|
|
|= txt/tape
|
|
^- (each (unit (each dojo-command tape)) @ud)
|
|
=+ foy=(he-dope txt)
|
|
?- -.foy
|
|
%| [%| q.p.foy]
|
|
%& [%& p.foy]
|
|
==
|
|
::
|
|
++ he-abet :: resolve
|
|
[(flop moz) %_(state hoc (~(put by hoc) id +<+>+))]
|
|
::
|
|
++ he-card :: emit gift
|
|
|= =card:agent:gall
|
|
^+ +>
|
|
=? card ?=(%pass -.card)
|
|
card(p [id p.card])
|
|
%_(+> moz [card moz])
|
|
::
|
|
++ he-diff :: emit update
|
|
|= fec/sole-effect
|
|
^+ +>
|
|
(he-card %give %fact ~[/sole/[id]] %sole-effect !>(fec))
|
|
::
|
|
++ he-stop :: abort work
|
|
^+ .
|
|
?~(poy . ~(dy-stop dy u.poy))
|
|
::
|
|
++ he-peer :: subscribe to
|
|
|= pax/path
|
|
?>(=(~ pax) he-prom)
|
|
::
|
|
++ he-pine :: restore prompt
|
|
^+ .
|
|
?^ poy .
|
|
he-prom:he-pone
|
|
::
|
|
++ he-errd :: reject update
|
|
|= {rev/(unit sole-edit) err/@u} ^+ +>
|
|
=+ red=(fall rev [%nop ~]) :: required for error location sync
|
|
=^ lic say (~(transmit sole say) red)
|
|
(he-diff %mor [%det lic] [%err err] ~)
|
|
::
|
|
++ he-pone :: clear prompt
|
|
^+ .
|
|
=^ cal say (~(transmit sole say) [%set ~])
|
|
(he-diff %mor [%det cal] ~)
|
|
::
|
|
++ he-prow :: where we are
|
|
^- tape
|
|
?: &(=(our.hid p.dir) =(%home q.dir) =([%ud 0] r.dir) =(~ s.dir)) ~
|
|
%+ weld
|
|
?: &(=(our.hid p.dir) =([%ud 0] r.dir))
|
|
(weld "/" (trip q.dir))
|
|
;: weld
|
|
"/" ?:(=(our.hid p.dir) "=" (scow %p p.dir))
|
|
"/" ?:(=(%home q.dir) "=" (trip q.dir))
|
|
"/" ?:(=([%ud 0] r.dir) "=" (scow r.dir))
|
|
==
|
|
?:(=(~ s.dir) "" (spud (flop s.dir)))
|
|
::
|
|
++ he-prom :: send prompt
|
|
%- he-diff
|
|
:- %pro
|
|
[& %$ (weld he-prow ?~(buf "> " "< "))]
|
|
::
|
|
++ he-writ
|
|
|= [way=wire =riot:clay]
|
|
^+ +>
|
|
?> ?=(^ poy)
|
|
=< he-pine
|
|
?+ way !!
|
|
[%hand *]
|
|
?~ riot
|
|
(he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~)
|
|
(~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot))
|
|
==
|
|
::
|
|
++ he-unto :: result from agent
|
|
|= {way/wire cit/sign:agent:gall}
|
|
^+ +>
|
|
?. ?=($poke-ack -.cit)
|
|
~& [%strange-unto cit]
|
|
+>
|
|
?~ p.cit
|
|
(he-diff %txt ">=")
|
|
(he-diff %tan leaf+"dojo: app poke failed" u.p.cit)
|
|
::
|
|
++ he-wool
|
|
|= [way=wire =sign:agent:gall]
|
|
^+ +>
|
|
?- -.sign
|
|
%poke-ack
|
|
?~ p.sign
|
|
+>.$
|
|
=. +>.$ (he-diff(poy ~) %tan leaf+"dojo: thread poke failed" u.p.sign)
|
|
(he-card %pass /wool %agent [our.hid %spider] %leave ~)
|
|
::
|
|
%watch-ack
|
|
?~ p.sign
|
|
+>.$
|
|
(he-diff(poy ~) %tan leaf+"dojo: thread watch failed" u.p.sign)
|
|
::
|
|
%fact
|
|
?+ p.cage.sign ~|([%dojo-thread-bad-mark-result p.cage.sign] !!)
|
|
%thread-fail
|
|
=+ !<([=term =tang] q.cage.sign)
|
|
%+ he-diff(poy ~) %tan
|
|
(flop `^tang`[leaf+"thread failed: {<term>}" tang])
|
|
::
|
|
%thread-done
|
|
?> ?=(^ poy)
|
|
(~(dy-hand dy u.poy(pux ~)) %noun q.cage.sign)
|
|
==
|
|
::
|
|
%kick +>.$
|
|
==
|
|
:: +he-http-response: result from http-client
|
|
::
|
|
++ he-http-response
|
|
|= [way=wire response=client-response:iris]
|
|
^+ +>
|
|
?> ?=(^ poy)
|
|
=< he-pine
|
|
?. ?=(%finished -.response)
|
|
~& %dojo-received-http-progress
|
|
+>
|
|
::
|
|
~! response
|
|
%. [%httr !>((to-httr:iris response-header.response full-file.response))]
|
|
=+ dye=~(. dy u.poy(pux ~))
|
|
?+ way !!
|
|
{$hand ~} dy-hand:dye
|
|
{$show ~} dy-show:dye
|
|
==
|
|
::
|
|
++ he-lens
|
|
|= com/command:lens
|
|
^+ +>
|
|
=/ source=dojo-source
|
|
=| num/@
|
|
=- ?. ?=($send-api -.sink.com) :: XX num is incorrect
|
|
sor
|
|
:- 0
|
|
:+ %as `mark`(cat 3 api.sink.com '-poke')
|
|
:- 1
|
|
:+ %do
|
|
^- hoon
|
|
:+ %brtr [%base %noun]
|
|
:^ %clls [%rock %tas %post]
|
|
[%rock %$ endpoint.sink.com]
|
|
[%cnts [%& 6]~ ~]
|
|
sor
|
|
^= sor
|
|
|- ^- dojo-source
|
|
:- num
|
|
?- -.source.com
|
|
$data [%ex %sand %t data.source.com]
|
|
$dojo
|
|
%+ rash command.source.com
|
|
(ifix [(punt gap) (punt gap)] parse-build:he-parser)
|
|
::
|
|
$clay
|
|
:- %ex
|
|
^- hoon
|
|
:+ %dtkt
|
|
[%base %noun]
|
|
:+ %clhp
|
|
[%rock %tas %cx]
|
|
%+ rash pax.source.com
|
|
rood:(vang | /(scot %p our.hid)/home/(scot %da now.hid))
|
|
::
|
|
$url [%ur (crip (en-purl:html url.source.com))]
|
|
$api !!
|
|
$get-api
|
|
:- %ex
|
|
^- hoon
|
|
:+ %dtkt
|
|
[%like ~[%json] ~]
|
|
:* %clsg
|
|
[%rock %tas %gx]
|
|
[%sand %ta (scot %p our.hid)]
|
|
[%sand %tas api.source.com]
|
|
[%sand %ta (scot %da now.hid)]
|
|
(turn endpoint.source.com |=(a/@t [%sand %ta a]))
|
|
==
|
|
::
|
|
$listen-api !!
|
|
$export !!
|
|
$import !!
|
|
$export-all !!
|
|
$import-all !!
|
|
$as
|
|
:* %as mar.source.com
|
|
$(num +(num), source.com next.source.com)
|
|
==
|
|
::
|
|
$hoon
|
|
:* %do
|
|
%+ rash code.source.com
|
|
tall:(vang | /(scot %p our.hid)/home/(scot %da now.hid))
|
|
$(num +(num), source.com next.source.com)
|
|
==
|
|
::
|
|
$tuple
|
|
:- %tu
|
|
|- ^- (list dojo-source)
|
|
?~ next.source.com
|
|
~
|
|
=. num +(num)
|
|
:- ^$(source.com i.next.source.com)
|
|
$(next.source.com t.next.source.com)
|
|
==
|
|
=+ |- ^- sink/dojo-sink
|
|
?- -.sink.com
|
|
$stdout [%show %0]
|
|
$output-file $(sink.com [%command (cat 3 '@' pax.sink.com)])
|
|
$output-pill $(sink.com [%command (cat 3 '.' pax.sink.com)])
|
|
$output-clay [%file (need (de-beam:format pax.sink.com))]
|
|
$url [%http %post (crip (en-purl:html url.sink.com))]
|
|
$to-api !!
|
|
$send-api [%poke our.hid api.sink.com]
|
|
$command (rash command.sink.com parse-sink:he-parser)
|
|
$app [%poke our.hid app.sink.com]
|
|
==
|
|
(he-plan sink source)
|
|
::
|
|
++ he-like :: accept line
|
|
|= buf/(list @c)
|
|
=(%& -:(he-dope (tufa buf)))
|
|
::
|
|
++ he-stir :: apply change
|
|
|= cal/sole-change
|
|
^+ +>
|
|
:: ~& [%his-clock ler.cal]
|
|
:: ~& [%our-clock ven.say]
|
|
=^ dat say (~(transceive sole say) cal)
|
|
?. ?& ?=($del -.dat)
|
|
=(+(p.dat) (lent buf.say))
|
|
==
|
|
+>.$
|
|
=+ foy=(he-dope (tufa buf.say))
|
|
?: ?=(%& -.foy) +>.$
|
|
:: ~& [%bad-change dat ted.cal]
|
|
:: ~& [%our-leg leg.say]
|
|
(he-errd `dat q.p.foy)
|
|
::
|
|
++ he-plan :: execute command
|
|
|= mad/dojo-command
|
|
^+ +>
|
|
?> ?=(~ poy)
|
|
he-pine:(dy-step:~(dy-init dy %*(. *dojo-project mad mad)) 0)
|
|
::
|
|
++ he-done :: parse command
|
|
|= txt/tape
|
|
^+ +>
|
|
?~ txt
|
|
=< he-prom(buf ~)
|
|
%- he-diff
|
|
:~ %mor
|
|
[%txt "> "]
|
|
[%nex ~]
|
|
==
|
|
=+ doy=(he-duke txt)
|
|
?- -.doy
|
|
%| (he-errd ~ p.doy)
|
|
%&
|
|
?~ p.doy
|
|
(he-errd ~ (lent txt))
|
|
=+ old=(weld ?~(buf "> " " ") (tufa buf.say))
|
|
=^ cal say (~(transmit sole say) [%set ~])
|
|
=. +>.$ (he-diff %mor txt+old nex+~ det+cal ~)
|
|
?- -.u.p.doy
|
|
%& (he-plan(buf ~) p.u.p.doy)
|
|
%| he-prom(buf p.u.p.doy)
|
|
==
|
|
==
|
|
::
|
|
++ he-tab
|
|
|= pos=@ud
|
|
^+ +>
|
|
=* res +>
|
|
=/ [back-pos=@ud fore-pos=@ud txt=tape]
|
|
(insert-magic:auto (add (lent buf) pos) :(weld buf (tufa buf.say)))
|
|
=/ id-len (sub fore-pos back-pos)
|
|
=/ fore-pos-diff (sub fore-pos pos)
|
|
=+ vex=((full parse-command-line:he-parser) [1 1] txt)
|
|
?. ?=([* ~ [* @ %ex *] *] vex)
|
|
(he-tab-not-hoon pos :(weld buf (tufa buf.say) "\0a"))
|
|
=/ typ p:(slop q:he-hoon-head !>(..dawn))
|
|
=/ tl (tab-list-hoon:auto typ p.q.q.p.u.q.vex)
|
|
=/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex)
|
|
=? res ?=(^ advance)
|
|
=/ to-send
|
|
(trip (rsh 3 (sub pos back-pos) u.advance))
|
|
=| fxs=(list sole-effect)
|
|
=. .
|
|
|- ^+ +.$
|
|
?. (gth fore-pos-diff 0)
|
|
+.$
|
|
=^ lic say (~(transmit sole say) %del pos)
|
|
%= $
|
|
fxs [det+lic fxs]
|
|
fore-pos-diff (dec fore-pos-diff)
|
|
==
|
|
:: =. pos (add pos fore-pos-diff)
|
|
|- ^+ res
|
|
?~ to-send
|
|
(he-diff %mor (flop fxs))
|
|
=^ lic say (~(transmit sole say) %ins pos `@c`i.to-send)
|
|
$(to-send t.to-send, fxs [`sole-effect`det+lic fxs], pos +(pos))
|
|
:: If couldn't search (eg cursor not in appropriate position), do
|
|
:: nothing.
|
|
::
|
|
?: ?=(~ tl)
|
|
res
|
|
:: If no options, ring the bell
|
|
::
|
|
?: =([~ ~] tl)
|
|
(he-diff %bel ~)
|
|
:: If only one option, don't print unless the option is already
|
|
:: typed in.
|
|
::
|
|
?: &(?=([* ~] u.tl) !=((met 3 (need advance)) id-len))
|
|
res
|
|
:: Else, print results
|
|
::
|
|
=/ lots (gth (lent u.tl) 10)
|
|
%+ he-diff %tab
|
|
%+ turn u.tl
|
|
|= [=term =type]
|
|
~| term
|
|
:- term
|
|
?: lots
|
|
*tank
|
|
:: +perk is broken because *perk crashes.
|
|
::
|
|
?: =(%perk term)
|
|
*tank
|
|
~(duck easy-print type)
|
|
::
|
|
:: Full tab complete for all Dojo sinks and sources is a madmans job.
|
|
:: Instead, we try to parse limited but common forms we know we can
|
|
:: autocomplete correctly
|
|
++ he-tab-not-hoon
|
|
|= [pos=@ud txt=tape]
|
|
^+ +>
|
|
=* res +>
|
|
|^
|
|
=/ naked-poke=(unit term)
|
|
%+ rust txt
|
|
(full (ifix [col (just `@`10)] ;~(pose sym (easy %$))))
|
|
?^ naked-poke
|
|
(complete-naked-poke u.naked-poke)
|
|
=/ variable=(unit term)
|
|
%+ rust txt
|
|
(full (ifix [tis (just `@`10)] ;~(pose sym (easy %$))))
|
|
?^ variable
|
|
(complete-variable u.variable)
|
|
=/ gen-poke-to-app=(unit [term term])
|
|
%+ rust txt
|
|
;~ sfix
|
|
;~ (glue bar)
|
|
;~(pose ;~(pfix col sym) (easy %$))
|
|
;~(pose sym (easy %$))
|
|
==
|
|
(just `@`10)
|
|
==
|
|
?^ gen-poke-to-app
|
|
(complete-gen-poke-to-app u.gen-poke-to-app)
|
|
=/ naked-gen=(unit term)
|
|
%+ rust txt
|
|
(full (ifix [lus (just `@`10)] ;~(pose sym (easy %$))))
|
|
?~ naked-gen
|
|
res
|
|
(complete-naked-gen u.naked-gen)
|
|
::
|
|
++ complete-naked-poke
|
|
|= app=term
|
|
=/ pax=path
|
|
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/app
|
|
%+ complete (cat 3 ':' app)
|
|
%+ murn ~(tap by dir:.^(arch %cy pax))
|
|
|= [=term ~]
|
|
^- (unit [^term tank])
|
|
?. =(app (end 3 (met 3 app) term))
|
|
~
|
|
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
|
|
~
|
|
`[(cat 3 ':' term) *tank]
|
|
::
|
|
++ complete-variable
|
|
|= variable=term
|
|
%+ complete variable
|
|
%+ murn ~(tap by var)
|
|
|= [name=term =cage]
|
|
^- (unit [term tank])
|
|
?. =(variable (end 3 (met 3 variable) name))
|
|
~
|
|
`[name (sell q.cage)]
|
|
::
|
|
++ complete-gen-poke-to-app
|
|
|= [app=term gen=term]
|
|
=. app
|
|
?:(?=(%$ app) %hood app)
|
|
%+ complete
|
|
?: =(%hood app)
|
|
(cat 3 '|' gen)
|
|
:((cury cat 3) ':' app '|' gen)
|
|
=/ pfix=path
|
|
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen/[app]
|
|
::
|
|
%^ tab-generators:auto pfix `app
|
|
%+ murn
|
|
~(tap by dir:.^(arch %cy pfix))
|
|
|= [=term ~]
|
|
?. =(gen (end 3 (met 3 gen) term))
|
|
~
|
|
?~ =<(fil .^(arch %cy (weld pfix ~[term %hoon])))
|
|
~
|
|
(some term)
|
|
::
|
|
++ complete-naked-gen
|
|
|= gen=term
|
|
%+ complete (cat 3 '+' gen)
|
|
=/ pax=path
|
|
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen
|
|
%^ tab-generators:auto pax ~
|
|
%+ murn
|
|
~(tap by dir:.^(arch %cy pax))
|
|
|= [=term ~]
|
|
?. =(gen (end 3 (met 3 gen) term))
|
|
~
|
|
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
|
|
~
|
|
(some term)
|
|
::
|
|
++ complete
|
|
|= [completing=term options=(list [term tank])]
|
|
?~ options
|
|
res
|
|
=/ advance
|
|
(longest-match:auto options)
|
|
=. pos
|
|
(dec (lent txt)) :: lock cursor at end
|
|
=/ back-pos
|
|
(sub pos (met 3 completing))
|
|
=/ to-send
|
|
(trip (rsh 3 (sub pos back-pos) advance))
|
|
=| fxs=(list sole-effect)
|
|
::
|
|
:: Cursor is guaranteed to be at end so we don't worry about the
|
|
:: backwards case
|
|
::
|
|
=. res
|
|
|- ^+ res
|
|
?~ to-send
|
|
(he-diff %mor (flop fxs))
|
|
=^ lic say (~(transmit sole say) %ins pos `@c`i.to-send)
|
|
$(to-send t.to-send, fxs [`sole-effect`det+lic fxs], pos +(pos))
|
|
:: If no options, ring the bell
|
|
::
|
|
?: =(~ options)
|
|
(he-diff %bel ~)
|
|
:: If only one option, don't print unless the option is already
|
|
:: typed in.
|
|
::
|
|
?: &(?=([* ~] options) !=((met 3 advance) (met 3 completing)))
|
|
res
|
|
:: Else, print results
|
|
::
|
|
%+ he-diff %tab
|
|
options
|
|
--
|
|
::
|
|
++ he-type :: apply input
|
|
|= act/sole-action
|
|
^+ +>
|
|
?^ poy
|
|
he-pine:(~(dy-type dy u.poy) act)
|
|
?- -.dat.act
|
|
$det (he-stir +.dat.act)
|
|
$ret (he-done (tufa buf.say))
|
|
$clr he-pine(buf "")
|
|
$tab (he-tab +.dat.act)
|
|
==
|
|
::
|
|
++ he-lame :: handle error
|
|
|= {wut/term why/tang}
|
|
^+ +>
|
|
%- (slog (flop `tang`[>%dojo-lame wut< why]))
|
|
?^ poy
|
|
he-pine:~(dy-amok dy u.poy)
|
|
he-pine :: XX give mean to original keystroke
|
|
::
|
|
++ he-hoon-head :: dynamic state
|
|
:: todo: how do i separate the toplevel 'dojo state' comment?
|
|
:: dojo state
|
|
::
|
|
:: our: the name of this urbit
|
|
:: now: the current time
|
|
:: eny: a piece of random entropy
|
|
::
|
|
^- cage
|
|
:- %noun
|
|
=+ sloop=|=({a/vase b/vase} ?:(=(*vase a) b ?:(=(*vase b) a (slop a b))))
|
|
%+ sloop
|
|
%- ~(rep by var)
|
|
|= {{a/term @ b/vase} c/vase} ^- vase
|
|
(sloop b(p face+[a p.b]) c)
|
|
!>([our=our now=now eny=eny]:hid)
|
|
--
|
|
--
|
|
^- agent:gall
|
|
|_ hid=bowl:gall
|
|
++ on-init
|
|
`..on-init
|
|
::
|
|
++ on-save
|
|
!>(state)
|
|
::
|
|
++ on-load
|
|
|= old=vase
|
|
?: ?=(%6 +<.old)
|
|
`..on-init(state !<(house old))
|
|
=/ old-5 !<([%5 egg=@u hoc=(map id session)] old)
|
|
=/ =house [%6 egg.old-5 hoc.old-5 *(set ship)]
|
|
`..on-init(state house)
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card:agent:gall _..on-init)
|
|
=^ moves state
|
|
^- (quip card:agent:gall house)
|
|
?+ mark ~|([%dojo-poke-bad-mark mark] !!)
|
|
::
|
|
%sole-action
|
|
=/ act !<(sole-action vase)
|
|
he-abet:(~(he-type he hid id.act ~ (~(got by hoc) id.act)) act)
|
|
::
|
|
%lens-command
|
|
=+ !<([=id =command:lens] vase)
|
|
he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command)
|
|
::
|
|
%allow-remote-login
|
|
=/ who !<(@p vase)
|
|
`state(acl (~(put in acl) who))
|
|
::
|
|
%revoke-remote-login
|
|
=/ who !<(@p vase)
|
|
:_ state(acl (~(del in acl) who))
|
|
[%give %kick ~ `who]~
|
|
::
|
|
%list-remote-logins
|
|
~& acl
|
|
`state
|
|
::
|
|
%wipe
|
|
~& %dojo-wipe
|
|
=. hoc
|
|
%- ~(run by hoc)
|
|
|= =session
|
|
%_ session
|
|
sur ~
|
|
lib ~
|
|
var ~
|
|
old ~
|
|
==
|
|
[~ state]
|
|
==
|
|
::
|
|
[moves ..on-init]
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card:agent:gall _..on-init)
|
|
?> ?| (team:title our.hid src.hid)
|
|
(~(has in acl) src.hid)
|
|
==
|
|
?> ?=([%sole @ ~] path)
|
|
=/ id i.t.path
|
|
=? hoc (~(has by hoc) id)
|
|
~& [%dojo-peer-replaced id]
|
|
(~(del by hoc) id)
|
|
=/ =session %*(. *session -.dir [our.hid %home ud+0])
|
|
=^ moves state
|
|
he-abet:~(he-prom he hid id ~ session)
|
|
[moves ..on-init]
|
|
::
|
|
++ on-leave
|
|
|= =path
|
|
?> ?=([%sole *] path)
|
|
=. hoc (~(del by hoc) t.path)
|
|
[~ ..on-init]
|
|
::
|
|
++ on-peek
|
|
|= path
|
|
*(unit (unit cage))
|
|
::
|
|
++ on-agent
|
|
|= [=wire =sign:agent:gall]
|
|
?> ?=([@ @ *] wire)
|
|
=/ =session (~(got by hoc) i.wire)
|
|
=/ he-full ~(. he hid i.wire ~ session)
|
|
=^ moves state
|
|
=< he-abet
|
|
^+ he
|
|
?+ i.t.wire ~|([%dojo-bad-on-agent wire -.sign] !!)
|
|
%poke (he-unto:he-full t.wire sign)
|
|
%wool (he-wool:he-full t.wire sign)
|
|
==
|
|
[moves ..on-init]
|
|
::
|
|
++ on-arvo
|
|
|= [=wire =sign-arvo]
|
|
?> ?=([@ *] wire)
|
|
=/ =session (~(got by hoc) i.wire)
|
|
=/ he-full ~(. he hid i.wire ~ session)
|
|
=^ moves state
|
|
=< he-abet
|
|
?+ +<.sign-arvo ~|([%dojo-bad-take +<.sign-arvo] !!)
|
|
%writ (he-writ:he-full t.wire +>.sign-arvo)
|
|
%http-response (he-http-response:he-full t.wire +>.sign-arvo)
|
|
==
|
|
[moves ..on-init]
|
|
:: if dojo fails unexpectedly, kill whatever each session is working on
|
|
::
|
|
++ on-fail
|
|
|= [=term =tang]
|
|
=/ sessions=(list (pair id session)) ~(tap by hoc)
|
|
|- ^- (quip card:agent:gall _..on-init)
|
|
?~ sessions
|
|
[~ ..on-init]
|
|
=^ cards-1 state
|
|
he-abet:(~(he-lame he hid p.i.sessions ~ q.i.sessions) term tang)
|
|
=^ cards-2 ..on-init
|
|
$(sessions t.sessions)
|
|
[(weld cards-1 cards-2) ..on-init]
|
|
--
|