mirror of
https://github.com/urbit/shrub.git
synced 2024-12-22 02:11:38 +03:00
5eec015343
6c938e1 resolved a merge conflict, but retained a reference to 'this'
from the wrong parent.
265 lines
6.6 KiB
Plaintext
265 lines
6.6 KiB
Plaintext
:: chat-store: data store that holds linear sequences of chat messages
|
|
::
|
|
/+ *chat-json, *chat-eval, default-agent
|
|
|%
|
|
+$ card card:agent:gall
|
|
+$ versioned-state
|
|
$% state-zero
|
|
==
|
|
::
|
|
+$ state-zero
|
|
$: %0
|
|
=inbox
|
|
==
|
|
::
|
|
+$ diff
|
|
$% [%chat-initial inbox]
|
|
[%chat-configs chat-configs]
|
|
[%chat-update chat-update]
|
|
==
|
|
--
|
|
::
|
|
=| state-zero
|
|
=* state -
|
|
^- agent:gall
|
|
=<
|
|
|_ =bowl:gall
|
|
+* this .
|
|
chat-core +>
|
|
cc ~(. chat-core bowl)
|
|
def ~(. (default-agent this %|) bowl)
|
|
::
|
|
++ on-init on-init:def
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old=vase
|
|
`this(state !<(state-zero old))
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
?> (team:title our.bowl src.bowl)
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%json (poke-json:cc !<(json vase))
|
|
%chat-action (poke-chat-action:cc !<(chat-action vase))
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?> (team:title our.bowl src.bowl)
|
|
|^
|
|
=/ cards=(list card)
|
|
?+ path (on-watch:def path)
|
|
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
|
|
[%all ~] (give %chat-initial !>(inbox))
|
|
[%configs ~] (give %chat-configs !>((inbox-to-configs inbox)))
|
|
[%updates ~] ~
|
|
[%mailbox @ *]
|
|
?> (~(has by inbox) t.path)
|
|
=/ =ship (slav %p i.t.path)
|
|
(give %chat-update !>([%create ship t.t.path]))
|
|
==
|
|
[cards this]
|
|
::
|
|
++ give
|
|
|= =cage
|
|
^- (list card)
|
|
[%give %fact ~ cage]~
|
|
--
|
|
::
|
|
++ on-leave on-leave:def
|
|
++ on-peek
|
|
|= =path
|
|
^- (unit (unit cage))
|
|
?+ path (on-peek:def path)
|
|
[%x %all ~] ``noun+!>(inbox)
|
|
[%x %configs ~] ``noun+!>((inbox-to-configs inbox))
|
|
[%x %keys ~] ``noun+!>(~(key by inbox))
|
|
[%x %envelopes ~] (peek-x-envelopes:cc t.t.path)
|
|
[%x %mailbox *]
|
|
?~ t.t.path
|
|
~
|
|
``noun+!>((~(get by inbox) t.t.path))
|
|
::
|
|
[%x %config *]
|
|
?~ t.t.path
|
|
~
|
|
=/ mailbox (~(get by inbox) t.t.path)
|
|
?~ mailbox
|
|
~
|
|
``noun+!>(config.u.mailbox)
|
|
==
|
|
::
|
|
++ on-agent on-agent:def
|
|
++ on-arvo on-arvo:def
|
|
++ on-fail on-fail:def
|
|
--
|
|
::
|
|
::
|
|
|_ bol=bowl:gall
|
|
::
|
|
++ peek-x-envelopes
|
|
|= pax=path
|
|
^- (unit (unit [%noun vase]))
|
|
?+ pax ~
|
|
[@ @ *]
|
|
=/ mail-path t.t.pax
|
|
=/ mailbox (~(get by inbox) mail-path)
|
|
?~ mailbox
|
|
[~ ~ %noun !>(~)]
|
|
=* envelopes envelopes.u.mailbox
|
|
=/ sign-test=[?(%neg %pos) @]
|
|
%- need
|
|
%+ rush i.pax
|
|
;~ pose
|
|
%+ cook
|
|
|= n=@
|
|
[%neg n]
|
|
;~(pfix hep dem:ag)
|
|
::
|
|
%+ cook
|
|
|= n=@
|
|
[%pos n]
|
|
dem:ag
|
|
==
|
|
=* length length.config.u.mailbox
|
|
=* start +.sign-test
|
|
?: =(-.sign-test %neg)
|
|
?: (gth start length)
|
|
[~ ~ %noun !>(envelopes)]
|
|
[~ ~ %noun !>((swag [(sub length start) start] envelopes))]
|
|
::
|
|
=/ end (slav %ud i.t.pax)
|
|
?. (lte start end)
|
|
~
|
|
=. end ?:((lth end length) end length)
|
|
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
|
|
==
|
|
::
|
|
++ poke-json
|
|
|= jon=json
|
|
^- (quip card _state)
|
|
(poke-chat-action (json-to-action jon))
|
|
::
|
|
++ poke-chat-action
|
|
|= action=chat-action
|
|
^- (quip card _state)
|
|
?- -.action
|
|
%create (handle-create action)
|
|
%delete (handle-delete action)
|
|
%message (handle-message action)
|
|
%messages (handle-messages action)
|
|
%read (handle-read action)
|
|
==
|
|
::
|
|
++ handle-create
|
|
|= act=chat-action
|
|
^- (quip card _state)
|
|
?> ?=(%create -.act)
|
|
=/ pax [(scot %p ship.act) path.act]
|
|
?: (~(has by inbox) pax)
|
|
[~ state]
|
|
:- (send-diff pax act)
|
|
state(inbox (~(put by inbox) pax *mailbox))
|
|
::
|
|
++ handle-delete
|
|
|= act=chat-action
|
|
^- (quip card _state)
|
|
?> ?=(%delete -.act)
|
|
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
|
|
?~ mailbox
|
|
[~ state]
|
|
:- (send-diff path.act act)
|
|
state(inbox (~(del by inbox) path.act))
|
|
::
|
|
++ handle-message
|
|
|= act=chat-action
|
|
^- (quip card _state)
|
|
?> ?=(%message -.act)
|
|
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
|
|
?~ mailbox
|
|
[~ state]
|
|
=. letter.envelope.act (evaluate-letter [author letter]:envelope.act)
|
|
=. u.mailbox (append-envelope u.mailbox envelope.act)
|
|
:- (send-diff path.act act)
|
|
state(inbox (~(put by inbox) path.act u.mailbox))
|
|
::
|
|
++ handle-messages
|
|
|= act=chat-action
|
|
^- (quip card _state)
|
|
?> ?=(%messages -.act)
|
|
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
|
|
?~ mailbox
|
|
[~ state]
|
|
=/ evaluated-envelopes=(list envelope) ~
|
|
|- ^- (quip card _state)
|
|
?~ envelopes.act
|
|
:_ state(inbox (~(put by inbox) path.act u.mailbox))
|
|
%+ send-diff path.act
|
|
:* %messages
|
|
path.act
|
|
(sub length.config.u.mailbox (lent evaluated-envelopes))
|
|
length.config.u.mailbox
|
|
evaluated-envelopes
|
|
==
|
|
=. letter.i.envelopes.act (evaluate-letter [author letter]:i.envelopes.act)
|
|
=. evaluated-envelopes (snoc evaluated-envelopes i.envelopes.act)
|
|
=. u.mailbox (append-envelope u.mailbox i.envelopes.act)
|
|
$(envelopes.act t.envelopes.act)
|
|
::
|
|
++ handle-read
|
|
|= act=chat-action
|
|
^- (quip card _state)
|
|
?> ?=(%read -.act)
|
|
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
|
|
?~ mailbox
|
|
[~ state]
|
|
=. read.config.u.mailbox length.config.u.mailbox
|
|
:- (send-diff path.act act)
|
|
state(inbox (~(put by inbox) path.act u.mailbox))
|
|
::
|
|
++ evaluate-letter
|
|
|= [author=ship =letter]
|
|
^- ^letter
|
|
=? letter
|
|
?& ?=(%code -.letter)
|
|
?=(~ output.letter)
|
|
(team:title our.bol author)
|
|
==
|
|
=/ =hoon (ream expression.letter)
|
|
letter(output (eval bol hoon))
|
|
letter
|
|
::
|
|
++ append-envelope
|
|
|= [=mailbox =envelope]
|
|
^- ^mailbox
|
|
=. number.envelope +(length.config.mailbox)
|
|
=: length.config.mailbox +(length.config.mailbox)
|
|
envelopes.mailbox (snoc envelopes.mailbox envelope)
|
|
==
|
|
mailbox
|
|
::
|
|
++ update-subscribers
|
|
|= [pax=path update=chat-update]
|
|
^- (list card)
|
|
[%give %fact `pax %chat-update !>(update)]~
|
|
::
|
|
++ send-diff
|
|
|= [pax=path upd=chat-update]
|
|
^- (list card)
|
|
%- zing
|
|
:~ (update-subscribers /all upd)
|
|
(update-subscribers /updates upd)
|
|
(update-subscribers [%mailbox pax] upd)
|
|
?. |(|(=(%read -.upd) =(%message -.upd)) =(%messages -.upd))
|
|
~
|
|
(update-subscribers /configs upd)
|
|
?. |(=(%create -.upd) =(%delete -.upd))
|
|
~
|
|
(update-subscribers /keys upd)
|
|
==
|
|
--
|