tloncorp/landscape
1
1
Fork 0
mirror of https://github.com/tloncorp/landscape.git synced 2024-11-24 01:37:01 +03:00
Code Issues Packages Projects Releases Wiki Activity

hark,contacts: updating from groups

Browse Source
This commit is contained in:
Hunter Miller 2023-07-13 12:46:25 -05:00
parent edda1fcf45
commit f2ae94b67d
9 changed files with 316 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
desk/app/contacts.hoon
View File

@ -1,34 +1,9 @@
/- *contacts
/+ default-agent, dbug, verb
:: performance, keep warm
/+ contacts-json
::
|%
:: [compat] protocol-versioning scheme
::
:: adopted from :groups, slightly modified.
::
:: for our action/update marks, we
:: - *must* support our version (+okay)
:: - *should* support previous versions (especially actions)
:: - but *can't* support future versions
::
:: in the case of updates at unsupported protocol versions,
:: we backoff and subscribe for version changes (/epic).
:: (this alone is unlikely to help with future versions,
:: but perhaps our peer will downgrade. in the meantime,
:: we wait to be upgraded.)
::
+| %compat
++ okay `epic`0
++ mar
|%
++ base
|%
+$ act %contact-action
+$ upd %contact-update
--
++ act `mark`^~((rap 3 *act:base '-' (scot %ud okay) ~))
++ upd `mark`^~((rap 3 *upd:base '-' (scot %ud okay) ~))
--
:: conventions
::
:: .con: a contact
@ -173,7 +148,7 @@
++ fact
|= [pat=(set path) u=update]
^- gift:agent:gall
[%fact ~(tap in pat) %contact-update-0 !>(u)]
[%fact ~(tap in pat) upd:mar !>(u)]
--
::
|%
@ -399,7 +374,7 @@
::
^+ cor
=/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl)
?. .^(? gu+bas) cor
?. .^(? gu+(weld bas /$)) cor
=/ ful .^(rolodex:legacy gx+(weld bas /all/noun))
::
|^ cor(rof us, rol them)

56
desk/app/hark.hoon
View File

@ -1,7 +1,8 @@
/- h=hark
/+ default-agent, verb, dbug
/+ hark-json :: performance
/+ mp=mop-extensions
:: performance, keep warm
/+ hark-json
|%
+$ card card:agent:gall
++ mope ((mp @ud thread:h) lte)
@ -15,7 +16,7 @@
^- (list _?>(?=(^ a) ?>(?=(^ b) [i.a i.b])))
?~ a ~
?~ b ~
:- [i.a i.b]
:- [i.a i.b]
$(a t.a, b t.b)
::
++ quilt-idx
@ -42,7 +43,7 @@
+* this .
cor ~(. +> [bowl ~])
def ~(. (default-agent this %|) bowl)
++ on-init
++ on-init
=^ cards state
abet:set-gc-wake:cor
[cards this]
@ -50,7 +51,7 @@
++ on-load
|= =vase
=/ old=(unit state-0)
(mole |.(!<(state-0 vase)))
(mole |.(!<(state-0 vase)))
?~ old on-init
`this(state u.old)
++ on-poke
@ -88,10 +89,29 @@
%hark-action
=+ !<(act=action:h vase)
=. cor (give-ui act)
?- -.act
%saw-rope (saw-rope rope.act)
%saw-seam (saw-seam +.act)
%add-yarn (add-yarn +.act)
?- -.act
%saw-rope (saw-rope rope.act)
%saw-seam (saw-seam seam.act)
%add-yarn (add-yarn +.act)
==
::
%hark-action-1
=+ !<(act=action-1:h vase)
?+ -.act $(mark %hark-action)
%new-yarn
=/ =action:h
:* %add-yarn
all.act
desk.act
:* (end [7 1] (shax eny.bowl))
rop.act
now.bowl
con.act
wer.act
but.act
==
==
$(mark %hark-action, vase !>(action))
==
==
++ peek
@ -108,7 +128,7 @@
(scry-rug rest.pole group/flag rug)
::
[%x %desk desk=@ rest=*]
(scry-rug rest.pole desk/desk.pole (~(got by desks) desk.pole))
(scry-rug rest.pole desk/desk.pole (~(gut by desks) desk.pole *rug:h))
::
[%x %yarn uid=@ ~]
``hark-yarn+!>((~(got by yarns) (slav %uv uid.pole)))
@ -137,7 +157,7 @@
cor
::
++ scry-rug
|= [=(pole knot) =seam:h =rug:h]
|= [=(pole knot) =seam:h =rug:h]
^- (unit (unit cage))
?+ pole [~ ~]
[%skeins ~] ``hark-skeins+!>((rug-to-skeins seam rug))
@ -288,7 +308,7 @@
:: +stale: garbage collection
::
++ stale
|^
|^
=/ ids ~(key by yarns)
=. ids (~(dif in ids) (ids-for-rug all))
=. ids (~(dif in ids) ids-for-groups)
@ -305,7 +325,7 @@
rug
:: TODO: bad asymptotics
=+ siz=(lent (tap:on qul.rug))
?: (lte siz 50)
?: (lte siz 50)
rug :: bail if not much there
=/ dip (dip:on ,count=@ud)
=. qul.rug
@ -314,7 +334,7 @@
|= [count=@ud key=@ud =thread:h]
^- [(unit thread:h) stop=? count=@ud]
=- [~ - +(count)]
(gte count rug-trim-size)
(gte count rug-trim-size)
rug
::
++ ids-for-rug
@ -351,14 +371,14 @@
--
++ saw-seam
|= =seam:h
=/ fun
=/ fun
|= =rug:h
=/ start (quilt-idx qul.rug)
=/ new ~(val by new.rug)
%_ rug
new ~
::
qul
qul
%+ gas:on:quilt:h qul.rug
(zip (gulf start (add start (lent new))) new)
==
@ -385,21 +405,21 @@
++ weave-rug
|= [=rug:h =seam:h]
=/ =thread:h (~(gut by new.rug) rop.yarn ~)
=. thread (~(put in thread) id.yarn)
=. thread (~(put in thread) id.yarn)
=. new.rug (~(put by new.rug) rop.yarn thread)
rug
::
++ weave-group
?~ gop.rop.yarn cor
=* group u.gop.rop.yarn
=/ =rug:h (~(gut by groups) group *rug:h)
=/ =rug:h (~(gut by groups) group *rug:h)
=. rug (weave-rug rug group/group)
=. groups (~(put by groups) group rug)
cor
::
++ weave-desk
?. add-desk cor
=/ =rug:h (~(gut by desks) des.rop.yarn *rug:h)
=/ =rug:h (~(gut by desks) des.rop.yarn *rug:h)
=. rug (weave-rug rug desk/des.rop.yarn)
=. desks (~(put by desks) des.rop.yarn rug)
cor

10
desk/lib/groups-json.hoon
View File

@ -1,19 +1,21 @@
/- g=groups
|%
++ enjs
=, enjs:format
|%
++ flag
|= f=flag:h
|= f=flag:g
(rap 3 (scot %p p.f) '/' q.f ~)
::
++ nest
|= n=nest:h
|= n=nest:g
(rap 3 p.n '/' (flag q.n) ~)
--
++ dejs
=, dejs:format
|%
++ flag (su ;~((glue fas) ;~(pfix sig fed:ag) ^sym))
++ nest (su ;~((glue fas) ^sym ;~(pfix sig fed:ag)
++ ship (se %p)
++ flag (su ;~((glue fas) ;~(pfix sig fed:ag) sym))
++ nest (su ;~((glue fas) sym ;~(pfix sig fed:ag)))
--
--

63
desk/lib/hark-json.hoon
View File

@ -1,5 +1,5 @@
/- h=hark
/+ gj=groups-json
/+ groups-json
|%
++ enjs
=, enjs:format
@ -136,8 +136,8 @@
%desk s/desk.s
==
::
++ flag flag:enjs:gj
++ nest nest:enjs:gj
++ flag flag:enjs:groups-json
++ nest nest:enjs:groups-json
::
++ rope
|= r=rope:h
@ -154,10 +154,17 @@
=, dejs:format
|%
++ action
^- $-(json action:h)
%- of
:~ saw-seam/seam
saw-rope/rope
add-yarn/add-yarn
==
++ action-1
%- of
:~ saw-seam/seam
saw-rope/rope
add-yarn/add-yarn
new-yarn/new-yarn
==
::
++ seam
@ -167,9 +174,53 @@
group/flag
==
::
++ flag flag:dejs:gj
++ nest nest:dejs:gj
++ add-yarn
%- ot
:~ all/bo
desk/bo
yarn/yarn
==
::
++ new-yarn
%- ot
:~ all/bo
desk/bo
rope/rope
con/(ar content)
wer/pa
but/(mu button)
==
::
++ button
%- ot
:~ title/so
hanlder/pa
==
::
++ content
|= j=json
^- content:h
?: ?=([%s *] j) p.j
=> .(j `json`j)
%. j
%- of
:~ ship/ship
emph/so
==
::
++ yarn
%- ot
:~ id/(se %uvh)
rope/rope
time/(se %da)
con/(ar content)
wer/pa
but/(mu button)
==
::
++ flag flag:dejs:groups-json
++ nest nest:dejs:groups-json
++ ship ship:dejs:groups-json
++ rope
%- ot
:~ group/(mu flag)

6
desk/lib/mark-warmer.hoon Normal file
View File

@ -0,0 +1,6 @@
/$ rolo %contact-rolodex %json
/$ contact %contact %json
/$ skeins %hark-skeins %json
/$ carpet %hark-carpet %json
/$ blanket %hark-blanket %json
~

139
desk/lib/mop-extensions.hoon Normal file
View File

@ -0,0 +1,139 @@
|* [key=mold val=mold]
=> |%
+$ item [key=key val=val]
--
~% %mope-comp ..zuse ~
|= compare=$-([key key] ?)
~% %mope-core ..zuse ~
|%
:: +bat: tabulate a subset excluding start element with a max count (backwards)
::
++ bat
|= [a=(tree item) b=(unit key) c=@]
^- (list item)
|^
e:(tabulate (del-span a b) b c)
::
++ tabulate
|= [a=(tree item) b=(unit key) c=@]
^- [d=@ e=(list item)]
?: ?&(?=(~ b) =(c 0))
[0 ~]
=| f=[d=@ e=(list item)]
|- ^+ f
?: ?|(?=(~ a) =(d.f c)) f
=. f $(a r.a)
?: =(d.f c) f
=. f [+(d.f) [n.a e.f]]
?:(=(d.f c) f $(a l.a))
::
++ del-span
|= [a=(tree item) b=(unit key)]
^- (tree item)
?~ a a
?~ b a
?: =(key.n.a u.b)
l.a
?. (compare key.n.a u.b)
$(a l.a)
a(r $(a r.a))
--
:: +dop: dip:on but in reverse order (right to left)
::
++ dop
|* state=mold
|= $: a=(tree item)
=state
f=$-([state item] [(unit val) ? state])
==
^+ [state a]
:: acc: accumulator
::
:: .stop: set to %.y by .f when done traversing
:: .state: threaded through each run of .f and produced by +abet
::
=/ acc [stop=`?`%.n state=state]
=< abet =< main
|%
++ this .
++ abet [state.acc a]
:: +main: main recursive loop; performs a partial inorder traversal
::
++ main
^+ this
:: stop if empty or we've been told to stop
::
?: =(~ a) this
?: stop.acc this
:: reverse in-order traversal: right -> node -> left, until .f sets .stop
::
=. this right
?: stop.acc this
=^ del this node
=? this !stop.acc left
:: XX: remove for now; bring back when upstreaming
:: =? a del (nip a)
this
:: +node: run .f on .n.a, updating .a, .state, and .stop
::
++ node
^+ [del=*? this]
:: run .f on node, updating .stop.acc and .state.acc
::
?> ?=(^ a)
=^ res acc (f state.acc n.a)
?~ res
[del=& this]
[del=| this(val.n.a u.res)]
:: +left: recurse on left subtree, copying mutant back into .l.a
::
++ left
^+ this
?~ a this
=/ lef main(a l.a)
lef(a a(l a.lef))
:: +right: recurse on right subtree, copying mutant back into .r.a
::
++ right
^+ this
?~ a this
=/ rig main(a r.a)
rig(a a(r a.rig))
--
:: +bot: produce the N leftmost elements
::
++ bot
|= [a=(tree item) b=@]
^- (list item)
|^ p:(items-with-remainder a b)
++ items-with-remainder
|= [a=(tree item) b=@]
^- (pair (list item) @)
?~ a [~ b]
?: =(b 0) [~ 0]
=/ left-result (items-with-remainder l.a b)
?: =(q.left-result 0) left-result
?: =(q.left-result 1) [(zing ~[p.left-result ~[n.a]]) (dec q.left-result)]
=/ right-result
(items-with-remainder r.a (dec q.left-result))
[(zing ~[p.left-result ~[n.a] p.right-result]) q.right-result]
--
:: +top: produce the N rightmost elements
::
++ top
|= [a=(tree item) b=@]
^- (list item)
|^ p:(items-with-remainder a b)
++ items-with-remainder
|= [a=(tree item) b=@]
^- (pair (list item) @)
?~ a [~ b]
?: =(b 0) [~ 0]
=/ right-result (items-with-remainder r.a b)
?: =(q.right-result 0) right-result
?: =(q.right-result 1) [[n.a p.right-result] (dec q.right-result)]
=/ left-result
(items-with-remainder l.a (dec q.right-result))
[(zing ~[p.left-result ~[n.a] p.right-result]) q.left-result]
--
--

14
desk/mar/hark/action-1.hoon Normal file
View File

@ -0,0 +1,14 @@
/- h=hark
/+ j=hark-json
|_ action=action-1:h
++ grad %noun
++ grow
|%
++ noun action
--
++ grab
|%
++ noun action-1:h
++ json action-1:dejs:j
--
--

30
desk/sur/contacts.hoon
View File

@ -1,5 +1,35 @@
/- e=epic, g=groups
|%
:: [compat] protocol-versioning scheme
::
:: adopted from :groups, slightly modified.
::
:: for our action/update marks, we
:: - *must* support our version (+okay)
:: - *should* support previous versions (especially actions)
:: - but *can't* support future versions
::
:: in the case of updates at unsupported protocol versions,
:: we backoff and subscribe for version changes (/epic).
:: (this alone is unlikely to help with future versions,
:: but perhaps our peer will downgrade. in the meantime,
:: we wait to be upgraded.)
::
+| %compat
++ okay `epic`0
++ mar
|%
++ base
|%
+$ act %contact-action
+$ upd %contact-update
--
::
++ act `mark`^~((rap 3 *act:base '-' (scot %ud okay) ~))
++ upd `mark`^~((rap 3 *upd:base '-' (scot %ud okay) ~))
--
::
+| %types
+$ contact
$: nickname=@t
bio=@t

31
desk/sur/hark.hoon
View File

@ -1,11 +1,11 @@
/- g=groups
|%
:: $rope: notification origin
::
::
:: Shows where a notification has come from. Used to group
:: notifications into threads
+$ rope
$: gop=(unit flag:g) :: originating group
$: gop=(unit flag) :: originating group
can=(unit nest:g) :: originating channel
des=desk :: originating desk
ted=path :: threading identifer
@ -25,11 +25,21 @@
but=(unit button) :: action, if any
==
::
:: $new-yarn: type for creating yarns
+$ new-yarn
$: all=?
desk=?
rop=rope
con=(list content)
wer=path
but=(unit button)
==
::
+$ button
$: title=cord
handler=path
==
::
+$ flag (pair ship term)
:: $content: notification text to be rendered
+$ content
$@ @t
@ -37,18 +47,24 @@
[%emph p=cord]
==
:: $action: Actions for hark
::
::
:: %add-yarn adds a notification to the relevant inboxes, indicated
:: by the loobs in the type
:: %saw-seam marks all notifications in an inbox as unread
:: %saw-rope marks a particular rope as read in all inboxes
::
+$ action
$% [%add-yarn all=? desk=? =yarn]
$% [%add-yarn all=? desk=? =yarn]
[%saw-seam =seam]
[%saw-rope =rope]
==
::
:: $action-1: Actions for hark pt 2
+$ action-1
$% [%new-yarn new-yarn]
action
==
::
+$ update
$: yarns=(map id yarn)
=seam
@ -70,12 +86,11 @@
::
:: All notifications end up in one of these inboxes
+$ seam
$% [%group =flag:g]
$% [%group =flag]
[%desk =desk]
[%all ~]
==
:: $rug: notifications inbox
::
:: .new contains all "unread" notifications, grouped by $rope
:: .qul is an archive
::
@ -85,7 +100,6 @@
=< quilt
|%
:: $quilt: inbox archive
::
:: Threads are keyed by an autoincrementing counter that starts at
:: 0
::
@ -100,5 +114,4 @@
top=yarn
unread=?
==
::
--