contact-store: %allow/%disallow support

This commit is contained in:
Logan Allen 2021-01-11 15:09:41 -06:00
parent dca2c9ae58
commit cdb91291ed
3 changed files with 82 additions and 23 deletions

View File

@ -2,11 +2,16 @@
::
:: data store that holds individual contact data
::
/- store=contact-store
/- store=contact-store, *resource
/+ default-agent, dbug, *migrate
|%
+$ card card:agent:gall
+$ state-4 [%4 =rolodex:store]
+$ state-4
$: %4
=rolodex:store
allowed-groups=(set resource)
allowed-ships=(set ship)
==
+$ versioned-state
$% [%0 *]
[%1 *]
@ -41,14 +46,15 @@
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give [%initial rolodex])
[%updates ~] ~
==
[cards this]
::
++ give
|= =cage
|= =update:store
^- (list card)
[%give %fact ~ cage]~
[%give %fact ~ [%contact-update !>(update)]]~
--
::
++ on-poke
@ -68,10 +74,12 @@
^- (quip card _state)
|^
?- -.update
%initial (handle-initial +.update)
%add (handle-add +.update)
%remove (handle-remove +.update)
%edit (handle-edit +.update)
%initial (handle-initial +.update)
%add (handle-add +.update)
%remove (handle-remove +.update)
%edit (handle-edit +.update)
%allow (handle-allow +.update)
%disallow (handle-disallow +.update)
==
::
++ handle-initial
@ -97,22 +105,42 @@
::
++ handle-edit
|= [=ship =edit-field:store]
|^
^- (quip card _state)
=/ contact (~(got by rolodex) ship)
=. contact (edit-contact contact edit-field)
:- (send-diff [%edit ship edit-field])
state(rolodex (~(put by rolodex) ship contact))
::
++ edit-contact
|= [=contact:store edit=edit-field:store]
^- contact:store
?- -.edit
%nickname contact(nickname nickname.edit)
%email contact(email email.edit)
%phone contact(phone phone.edit)
%website contact(website website.edit)
%color contact(color color.edit)
%avatar contact(avatar avatar.edit)
==
--
::
++ edit-contact
|= [=contact:store edit=edit-field:store]
^- contact:store
?- -.edit
%nickname contact(nickname nickname.edit)
%email contact(email email.edit)
%phone contact(phone phone.edit)
%website contact(website website.edit)
%color contact(color color.edit)
%avatar contact(avatar avatar.edit)
++ handle-allow
|= =beings:store
^- (quip card _state)
:- (send-diff [%allow beings])
?- -.beings
%group state(allowed-groups (~(put in allowed-groups) resource.beings))
%ships state(allowed-ships (~(uni in allowed-ships) ships.beings))
==
::
++ handle-disallow
|= =beings:store
^- (quip card _state)
:- (send-diff [%disallow beings])
?- -.beings
%group state(allowed-groups (~(del in allowed-groups) resource.beings))
%ships state(allowed-ships (~(dif in allowed-ships) ships.beings))
==
::
++ send-diff
@ -133,12 +161,11 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(rolodex)
[%x %export ~] ``noun+!>(state)
::
[%x %contact @ ~]
=/ =ship (slav %p i.t.t.path)
=/ contact=(unit contact:store) (~(get by rolodex) ship)
?~ contact ~
?~ contact [~ ~]
:- ~ :- ~ :- %contact-update
!> ^- update:store
[%add ship u.contact]

View File

@ -1,4 +1,5 @@
/- sur=contact-store
/+ res=resource
=< [sur .]
=, sur
|%
@ -19,8 +20,7 @@
^- [cord json]
?- -.upd
%initial
:- %initial
(pairs [%rolodex (rolo rolodex.upd)]~)
[%initial (rolo rolodex.upd)]
::
%add
:- %add
@ -39,6 +39,14 @@
:~ [%ship (ship ship.upd)]
[%edit-field (edit edit-field.upd)]
==
::
%allow
:- %allow
(pairs [%beings (beng beings.upd)]~)
::
%disallow
:- %disallow
(pairs [%beings (beng beings.upd)]~)
==
::
++ rolo
@ -74,9 +82,17 @@
%color s+(scot %ux color.field)
%avatar ?~(avatar.field ~ s+u.avatar.field)
==
::
++ beng
|= =beings
^- json
?- -.beings
%ships [%a (turn ~(tap in ships.beings) |=(s=^ship s+(scot %p s)))]
%group (enjs:res resource.beings)
==
--
::
++ dej
++ dejs
=, dejs:format
|%
++ update
@ -90,6 +106,8 @@
[%add add-contact]
[%remove remove-contact]
[%edit edit-contact]
[%allow beings]
[%disallow beings]
==
::
++ initial (op ;~(pfix sig fed:ag) cont)
@ -108,6 +126,12 @@
[%edit-field edit]
==
::
++ beings
%- of
:~ [%ships (as (su ;~(pfix sig fed:ag)))]
[%group dejs:res]
==
::
++ cont
%- ot
:~ [%nickname so]

View File

@ -1,3 +1,4 @@
/- *resource
|%
+$ rolodex (map ship contact)
+$ contact
@ -18,10 +19,17 @@
[%avatar avatar=(unit @t)]
==
::
+$ beings
$% [%ships ships=(set ship)]
[%group =resource]
==
::
+$ update
$% [%initial =rolodex]
[%add =ship =contact]
[%remove =ship]
[%edit =ship =edit-field]
[%allow =beings]
[%disallow =beings]
==
--