shrub/pkg/arvo/app/invite-store.hoon
2020-10-28 21:54:02 +00:00

210 lines
5.3 KiB
Plaintext

:: invite-store [landscape]
/- store=invite-store
/+ res=resource, default-agent, dbug
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
::
+$ invitatory-0 (map serial:store invite-0)
+$ invite-0
$: =ship :: ship to subscribe to upon accepting invite
app=@tas :: app to subscribe to upon accepting invite
=path :: path to subscribe to upon accepting invite
recipient=ship :: recipient to receive invite
text=cord :: text to describe the invite
==
::
+$ state-0 [%0 invites=(map path invitatory-0)]
+$ state-1 [%1 =invites:store]
--
::
=| state-1
=* state -
%- agent:dbug
^- agent:gall
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:- ~
%_ this
invites.state
%- ~(gas by *invites:store)
[%graph *invitatory:store]~
==
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
`this(state old)
:- =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]~
!> ^- action:store
[%create %graph]
%= this
state
:- %1
%- ~(gas by *invites:store)
%+ murn ~(tap by invites.old)
|= [=path =invitatory-0]
^- (unit [term invitatory:store])
?. ?=([@ ~] path) ~
:- ~
:- i.path
%- ~(gas by *invitatory:store)
%+ murn ~(tap by invitatory-0)
|= [=serial:store =invite-0]
^- (unit [serial:store invite:store])
=/ resource=(unit resource:res) (de-path-soft:res path.invite-0)
?~ resource ~
:- ~
:- serial
^- invite:store
:* ship.invite-0
app.invite-0
u.resource
recipient.invite-0
text.invite-0
==
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-leave on-leave:def
++ on-fail on-fail:def
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] [%give %fact ~ %invite-update !>([%initial invites])]~
[%updates ~] ~
[%invitatory @ ~]
=/ inv=invitatory:store (~(got by invites) i.t.path)
[%give %fact ~ %invite-update !>([%invitatory inv])]~
==
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%invite-action (poke-invite-action !<(action:store vase))
==
[cards this]
::
++ poke-invite-action
|= =action:store
^- (quip card _state)
?- -.action
%create (handle-create +.action)
%delete (handle-delete +.action)
%invite (handle-invite +.action)
%accept (handle-accept +.action)
%decline (handle-decline +.action)
%invites ~|('only send this to %invite-hook' !!)
==
::
++ handle-create
|= =term
^- (quip card _state)
?: (~(has by invites) term)
[~ state]
:- (send-diff term [%create term])
state(invites (~(put by invites) term *invitatory:store))
::
++ handle-delete
|= =term
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
:- (send-diff term [%delete term])
state(invites (~(del by invites) term))
::
++ handle-invite
|= [=term =serial:store =invite:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=. serial (sham eny.bowl)
=. container (~(put by container) serial invite)
:- (send-diff term [%invite term serial invite])
state(invites (~(put by invites) term container))
::
++ handle-accept
|= [=term =serial:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=/ invite (~(get by container) serial)
?~ invite
[~ state]
=. container (~(del by container) serial)
:- (send-diff term [%accepted term serial u.invite])
state(invites (~(put by invites) term container))
::
++ handle-decline
|= [=term =serial:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=/ invite (~(get by container) serial)
?~ invite
[~ state]
=. container (~(del by container) serial)
:- (send-diff term [%decline term serial])
state(invites (~(put by invites) term container))
::
++ update-subscribers
|= [=path =update:store]
^- card
[%give %fact ~[path] %invite-update !>(update)]
::
++ send-diff
|= [=term =update:store]
^- (list card)
:~ (update-subscribers /all update)
(update-subscribers /updates update)
(update-subscribers /invitatory/[term] update)
==
--
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~]
``noun+!>(invites)
::
[%x %invitatory @ ~]
:^ ~ ~ %noun
!> ^- (unit invitatory:store)
(~(get by invites) i.t.t.path)
::
[%x %invite @ @ ~]
=* term i.t.t.path
=/ =serial:store (slav %uv i.t.t.t.path)
?. (~(has by invites) term)
~
=/ =invitatory:store (~(got by invites) term)
:^ ~ ~ %noun
!> ^- (unit invite:store)
(~(get by invitatory) serial)
==
--