shrub/pkg/arvo/lib/chat-store.hoon
2020-08-13 01:11:12 -07:00

226 lines
4.8 KiB
Plaintext

/- sur=chat-store
^?
=< [sur .]
=, sur
|%
++ enjs
=, enjs:format
|%
::
++ letter
|= =^letter
^- json
?- -.letter
%text
(frond %text s+text.letter)
::
%me
(frond %me s+narrative.letter)
::
%url
(frond %url s+url.letter)
::
%code
%+ frond %code
%- pairs
:- [%expression s+expression.letter]
:_ ~
:- %output
:: virtualize output rendering, +tank:enjs:format might crash
::
=/ result=(each (list json) tang)
(mule |.((turn output.letter tank)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
==
::
++ envelope
|= =^envelope
^- json
%- pairs
:~ [%uid s+(scot %uv uid.envelope)]
[%number (numb number.envelope)]
[%author (ship author.envelope)]
[%when (time when.envelope)]
[%letter (letter letter.envelope)]
==
::
++ config
|= =^config
^- json
%- pairs
:~ [%length (numb length.config)]
[%read (numb read.config)]
==
::
++ update
|= upd=^update
^- json
%+ frond %chat-update
%- pairs
:_ ~
?- -.upd
%initial
:- %initial
%- pairs
%+ turn ~(tap by inbox.upd)
|= [pax=^path =mailbox]
^- [cord json]
:- (spat pax)
%- pairs
:~ [%envelopes [%a (turn envelopes.mailbox envelope)]]
[%config (config config.mailbox)]
==
::
%message
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (envelope envelope.upd)]
==
::
%messages
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd envelope)]]
==
::
%read
[%read (pairs [%path (path path.upd)]~)]
::
%create
[%create (pairs [%path (path path.upd)]~)]
::
%delete
[%delete (pairs [%path (path path.upd)]~)]
::
%keys
:- %keys
:- %a
%+ turn ~(tap by keys.upd)
|= pax=^path (path pax)
==
--
++ dejs
=, dejs:format
|%
::
++ action
|= jon=json
^- ^action
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%message message]
[%messages messages]
[%read read]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ message
%- ot
:~ [%path pa]
[%envelope envelope]
==
::
++ messages
%- ot
:~ [%path pa]
[%envelopes (ar envelope)]
==
::
++ read
(ot [%path pa] ~)
::
++ envelope
%- ot
:~ [%uid serial]
[%number ni]
[%author (su ;~(pfix sig fed:ag))]
[%when di]
[%letter letter]
==
::
++ letter
%- of
:~ [%text so]
[%url so]
[%code eval]
[%me so]
==
::
++ serial
^- $-(json ^serial)
(cu (cury slav %uv) so)
::
++ re :: recursive reparsers
|* {gar/* sef/_|.(fist:dejs-soft:format)}
|= jon/json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ dank :: tank
^- $-(json (unit tank))
=, ^? dejs-soft:format
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
:: %exp speech
++ eval
::: extract contents of an %exp speech, evaluating
::: the {exp} if there is no {res} yet.
::
|= a=json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
::NOTE when sending, if output is an empty list, chat-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
::
--
--
::
++ eval
|= [=bowl:gall =hoon]
^- (list tank)
=/ fowl=[our=@p now=@da eny=@uvJ]
:+ our.bowl
now.bowl
(shaz (cat 3 (mix [now eny]:bowl) %eny))
::
=/ subject [fowl ..zuse]
=/ minted=(each [=type =nock] (list tank))
%- mule |.
(~(mint ut -:!>(subject)) %noun hoon)
?: ?=(%| -.minted) p.minted
=/ =toon
(mock [subject nock.p.minted] |=(^ ~))
?- -.toon
%0 [(sell type.p.minted p.toon) ~]
%1 :- leaf+".^ unsupported in chat eval"
(turn ;;((list path) p.toon) smyt)
%2 [leaf+"crash!" p.toon]
==
--