mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-09-21 07:28:30 +03:00
shoe: console application library
Deals with sole events, deferring to the underlying app only for higher- level sole-handling logic. Currently doesn't offer fancy printing logic, but can easily be extended to do so. Passes sole-ids on to the underlying app in all arms so that it may run session-specific logic wherever it desires.
This commit is contained in:
parent
2fddfea082
commit
f103c65051
64
pkg/arvo/app/shoe.hoon
Normal file
64
pkg/arvo/app/shoe.hoon
Normal file
@ -0,0 +1,64 @@
|
||||
:: shoe: example usage of /lib/shoe
|
||||
::
|
||||
/+ shoe, verb, dbug, default-agent
|
||||
|%
|
||||
+$ state-0 [%0 ~]
|
||||
+$ command ~
|
||||
::
|
||||
+$ card card:shoe
|
||||
--
|
||||
=| state-0
|
||||
=* state -
|
||||
::
|
||||
%+ verb |
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
%- (agent:shoe command)
|
||||
^- (shoe:shoe command)
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
des ~(. (default:shoe this command) bowl)
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card _this)
|
||||
[~ this]
|
||||
::
|
||||
++ on-poke on-poke:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
::
|
||||
++ command-parser
|
||||
|= sole-id=@ta
|
||||
^+ |~(nail *(like command))
|
||||
(cold ~ (jest 'demo'))
|
||||
::
|
||||
++ tab-list
|
||||
|= sole-id=@ta
|
||||
^- (list [@t tank])
|
||||
:~ ['demo' leaf+"run example command"]
|
||||
==
|
||||
::
|
||||
++ on-command
|
||||
|= [sole-id=@ta =command]
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
[%shoe ~ %sole %txt "{(scow %p src.bowl)} ran the command"]~
|
||||
::
|
||||
++ can-connect
|
||||
|= sole-id=@ta
|
||||
^- ?
|
||||
?| =(~zod src.bowl)
|
||||
(team:title [our src]:bowl)
|
||||
==
|
||||
::
|
||||
++ on-connect on-connect:des
|
||||
++ on-disconnect on-disconnect:des
|
||||
--
|
341
pkg/arvo/lib/shoe.hoon
Normal file
341
pkg/arvo/lib/shoe.hoon
Normal file
@ -0,0 +1,341 @@
|
||||
:: shoe: console application library
|
||||
::
|
||||
:: /lib/sole: draw some characters
|
||||
:: /lib/shoe: draw the rest of the fscking app
|
||||
::
|
||||
:: call +agent with a type, then call the resulting function with a core
|
||||
:: of the shape described in +shoe.
|
||||
:: you may produce classic gall cards and "shoe-effects", shorthands for
|
||||
:: sending cli events to connected clients.
|
||||
:: default implementations for the shoe-specific arms are in +default.
|
||||
:: for a simple usage example, see /app/shoe.
|
||||
::
|
||||
/- *sole
|
||||
/+ sole, auto=language-server-complete
|
||||
|%
|
||||
+$ state-0
|
||||
$: %0
|
||||
soles=(map @ta sole-share)
|
||||
==
|
||||
:: $card: standard gall cards plus shoe effects
|
||||
::
|
||||
+$ card
|
||||
$% card:agent:gall
|
||||
[%shoe sole-ids=(list @ta) effect=shoe-effect] :: ~ sends to all soles
|
||||
==
|
||||
:: $shoe-effect: easier sole-effects
|
||||
::
|
||||
+$ shoe-effect
|
||||
$% [%sole effect=sole-effect]
|
||||
::TODO complex screen-draw effects
|
||||
==
|
||||
:: +shoe: gall agent core with extra arms
|
||||
::
|
||||
++ shoe
|
||||
|* command-type=mold
|
||||
$_ ^|
|
||||
|_ bowl:gall
|
||||
++ command-parser
|
||||
|~ sole-id=@ta
|
||||
|~(nail *(like command-type))
|
||||
::
|
||||
++ tab-list
|
||||
|~ sole-id=@ta
|
||||
:: (list [@t tank])
|
||||
*(list (option:auto tank))
|
||||
::
|
||||
++ on-command
|
||||
|~ [sole-id=@ta command=command-type]
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ can-connect
|
||||
|~ sole-id=@ta
|
||||
*?
|
||||
::
|
||||
++ on-connect
|
||||
|~ sole-id=@ta
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-disconnect
|
||||
|~ sole-id=@ta
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
::NOTE standard gall agent arms below, though they may produce %shoe cards
|
||||
::
|
||||
++ on-init
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-save
|
||||
*vase
|
||||
::
|
||||
++ on-load
|
||||
|~ vase
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-poke
|
||||
|~ [mark vase]
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-watch
|
||||
|~ path
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-leave
|
||||
|~ path
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-peek
|
||||
|~ path
|
||||
*(unit (unit cage))
|
||||
::
|
||||
++ on-agent
|
||||
|~ [wire sign:agent:gall]
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-arvo
|
||||
|~ [wire sign-arvo]
|
||||
*(quip card _^|(..on-init))
|
||||
::
|
||||
++ on-fail
|
||||
|~ [term tang]
|
||||
*(quip card _^|(..on-init))
|
||||
--
|
||||
:: +default: bare-minimum implementations of shoe arms
|
||||
::
|
||||
++ default
|
||||
|* [shoe=* command-type=mold]
|
||||
|_ =bowl:gall
|
||||
++ command-parser
|
||||
(easy *command-type)
|
||||
::
|
||||
++ tab-list
|
||||
~
|
||||
::
|
||||
++ on-command
|
||||
|= [sole-id=@ta command=command-type]
|
||||
[~ shoe]
|
||||
::
|
||||
++ can-connect
|
||||
|= sole-id=@ta
|
||||
?| =(~zod src.bowl)
|
||||
(team:title [our src]:bowl)
|
||||
==
|
||||
::
|
||||
++ on-connect
|
||||
|= sole-id=@ta
|
||||
[~ shoe]
|
||||
::
|
||||
++ on-disconnect
|
||||
|= sole-id=@ta
|
||||
[~ shoe]
|
||||
--
|
||||
:: +agent: creates wrapper core that handles sole events and calls shoe arms
|
||||
::
|
||||
++ agent
|
||||
|* command-type=mold
|
||||
|= =(shoe command-type)
|
||||
=| state-0
|
||||
=* state -
|
||||
^- agent:gall
|
||||
=>
|
||||
|%
|
||||
++ deal
|
||||
|= cards=(list card)
|
||||
%+ turn cards
|
||||
|= =card
|
||||
^- card:agent:gall
|
||||
?. ?=(%shoe -.card) card
|
||||
?- -.effect.card
|
||||
%sole
|
||||
=- [%give %fact - %sole-effect !>(effect.effect.card)]
|
||||
%+ turn
|
||||
?^ sole-ids.card sole-ids.card
|
||||
~(tap in ~(key by soles))
|
||||
|= sole-id=@ta
|
||||
/sole/[sole-id]
|
||||
==
|
||||
--
|
||||
::
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
og ~(. shoe bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
=^ cards shoe on-init:og
|
||||
[(deal cards) this]
|
||||
::
|
||||
++ on-save !>([shoe-inner=on-save:og shoe-self=state])
|
||||
::
|
||||
++ on-load
|
||||
|= old-state=vase
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
:: we could be upgrading from a shoe-less app, in which case the vase
|
||||
:: contains inner application state instead of our +on-save.
|
||||
:: to distinguish between the two, we check for the presence of our own
|
||||
:: +on-save faces in the vase.
|
||||
::
|
||||
|^ ?. worn
|
||||
=^ cards shoe (on-load:og old-state)
|
||||
[(deal cards) this]
|
||||
=^ old-inner state !<([vase state-0] old-state)
|
||||
=^ cards shoe (on-load:og old-inner)
|
||||
[(deal cards) this]
|
||||
::
|
||||
++ worn
|
||||
&((have %shoe-inner) (have %shoe-self))
|
||||
::
|
||||
++ have
|
||||
|= =term
|
||||
(head (mule |.((slab term -:old-state))))
|
||||
--
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
?. ?=(%sole-action mark)
|
||||
=^ cards shoe (on-poke:og mark vase)
|
||||
[(deal cards) this]
|
||||
::
|
||||
=/ act !<(sole-action vase)
|
||||
=* sole-id id.act
|
||||
=/ cli-state=sole-share
|
||||
(~(gut by soles) sole-id *sole-share)
|
||||
|^ =^ [cards=(list card) =_cli-state] shoe
|
||||
?- -.dat.act
|
||||
%det [(apply-edit +.dat.act) shoe]
|
||||
%clr [[~ cli-state] shoe]
|
||||
%ret run-command
|
||||
%tab [(tab +.dat.act) shoe]
|
||||
==
|
||||
:- (deal cards)
|
||||
this(soles (~(put by soles) sole-id cli-state))
|
||||
::
|
||||
++ effect
|
||||
|= =sole-effect
|
||||
^- card
|
||||
[%shoe [sole-id]~ %sole sole-effect]
|
||||
::
|
||||
++ apply-edit
|
||||
|= =sole-change
|
||||
^- (quip card _cli-state)
|
||||
=^ inverse cli-state
|
||||
(~(transceive sole cli-state) sole-change)
|
||||
:: res: & for fully parsed, | for parsing failure at location
|
||||
::
|
||||
=/ res=(each (unit) @ud)
|
||||
%+ rose (tufa buf.cli-state)
|
||||
(command-parser:og sole-id)
|
||||
?: ?=(%& -.res) [~ cli-state]
|
||||
:: parsing failed
|
||||
::
|
||||
?. &(?=(%del -.inverse) =(+(p.inverse) (lent buf.cli-state)))
|
||||
:: if edit was somewhere in the middle, let it happen anyway
|
||||
::
|
||||
[~ cli-state]
|
||||
:: if edit was insertion at buffer tail, revert it
|
||||
::
|
||||
=^ undo cli-state
|
||||
(~(transmit sole cli-state) inverse)
|
||||
:_ cli-state
|
||||
:_ ~
|
||||
%+ effect %mor
|
||||
:~ [%det undo] :: undo edit
|
||||
[%err p.res] :: cursor to error location
|
||||
==
|
||||
::
|
||||
++ run-command
|
||||
^+ [[*(list card) cli-state] shoe]
|
||||
=/ cmd=(unit command-type)
|
||||
%+ rust (tufa buf.cli-state)
|
||||
(command-parser:og sole-id)
|
||||
?~ cmd
|
||||
[[[(effect %bel ~)]~ cli-state] shoe]
|
||||
=^ cards shoe (on-command:og sole-id u.cmd)
|
||||
:: clear buffer
|
||||
::
|
||||
=^ clear cli-state (~(transmit sole cli-state) [%set ~])
|
||||
=- [[[- cards] cli-state] shoe]
|
||||
%+ effect %mor
|
||||
:~ [%nex ~]
|
||||
[%det clear]
|
||||
==
|
||||
::
|
||||
::NOTE cargo-culted
|
||||
++ tab
|
||||
|= pos=@ud
|
||||
^- (quip card _cli-state)
|
||||
=+ (get-id:auto pos (tufa buf.cli-state))
|
||||
=/ needle=term
|
||||
(fall id %$)
|
||||
:: autocomplete empty command iff user at start of command
|
||||
::
|
||||
=/ options=(list (option:auto tank))
|
||||
(search-prefix:auto needle (tab-list:og sole-id))
|
||||
=/ advance=term
|
||||
(longest-match:auto options)
|
||||
=/ to-send=tape
|
||||
%- trip
|
||||
(rsh 3 (met 3 needle) advance)
|
||||
=/ send-pos=@ud
|
||||
%+ add pos
|
||||
(met 3 (fall forward ''))
|
||||
=| cards=(list card)
|
||||
=? cards ?=(^ options)
|
||||
[(effect %tab options) cards]
|
||||
|- ^- (quip card _cli-state)
|
||||
?~ to-send
|
||||
[(flop cards) cli-state]
|
||||
=^ char cli-state
|
||||
(~(transmit sole cli-state) [%ins send-pos `@c`i.to-send])
|
||||
%_ $
|
||||
cards [(effect %det char) cards]
|
||||
send-pos +(send-pos)
|
||||
to-send t.to-send
|
||||
==
|
||||
--
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
?. ?=([%sole @ ~] path)
|
||||
=^ cards shoe
|
||||
(on-watch:og path)
|
||||
[(deal cards) this]
|
||||
=* sole-id i.t.path
|
||||
?> (can-connect:og sole-id)
|
||||
=. soles (~(put by soles) sole-id *sole-share)
|
||||
=^ cards shoe
|
||||
(on-connect:og sole-id)
|
||||
:_ this
|
||||
%- deal
|
||||
:_ cards
|
||||
[%shoe [sole-id]~ %sole %pro & dap.bowl "> "]
|
||||
::
|
||||
++ on-leave
|
||||
|= =path
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
=^ cards shoe (on-leave:og path)
|
||||
[(deal cards) this]
|
||||
::
|
||||
++ on-peek on-peek:og
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
=^ cards shoe (on-agent:og wire sign)
|
||||
[(deal cards) this]
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
=^ cards shoe (on-arvo:og wire sign-arvo)
|
||||
[(deal cards) this]
|
||||
::
|
||||
++ on-fail
|
||||
|= [=term =tang]
|
||||
^- (quip card:agent:gall agent:gall)
|
||||
=^ cards shoe (on-fail:og term tang)
|
||||
[(deal cards) this]
|
||||
--
|
||||
--
|
Loading…
Reference in New Issue
Block a user