mirror of
https://github.com/urbit/shrub.git
synced 2024-12-23 19:05:48 +03:00
579 lines
15 KiB
Plaintext
579 lines
15 KiB
Plaintext
:: hark-store: notifications and unread counts [landscape]
|
|
::
|
|
:: hark-store can store unread counts differently, depending on the
|
|
:: resource.
|
|
:: - last seen. This way, hark-store simply stores an index into
|
|
:: graph-store, which represents the last "seen" item, useful for
|
|
:: high-volume applications which are intrinsically time-ordered. i.e.
|
|
:: chats, comments
|
|
:: - each. Hark-store will store an index for each item that is unread.
|
|
:: Usefull for non-linear, low-volume applications, i.e. blogs,
|
|
:: collections
|
|
::
|
|
/- post, group-store, metadata-store
|
|
/+ resource, metadata, default-agent, dbug, graph-store, graphl=graph, verb, store=hark-store
|
|
::
|
|
::
|
|
~% %hark-store-top ..part ~
|
|
|%
|
|
+$ card card:agent:gall
|
|
+$ versioned-state
|
|
$% state:state-zero:store
|
|
state-1
|
|
==
|
|
+$ unread-stats
|
|
[indices=(set index:graph-store) last=@da]
|
|
::
|
|
+$ state-1
|
|
$: %1
|
|
unreads-each=(jug index:store index:graph-store)
|
|
unreads-count=(map index:store @ud)
|
|
last-seen=(map index:store @da)
|
|
=notifications:store
|
|
archive=notifications:store
|
|
current-timebox=@da
|
|
dnd=_|
|
|
==
|
|
+$ inflated-state
|
|
$: state-1
|
|
cache
|
|
==
|
|
:: $cache: useful to have precalculated, but can be derived from state
|
|
:: albeit expensively
|
|
+$ cache
|
|
$: by-index=(jug index:store @da)
|
|
~
|
|
==
|
|
::
|
|
++ orm ((ordered-map @da timebox:store) gth)
|
|
--
|
|
::
|
|
=| inflated-state
|
|
=* state -
|
|
::
|
|
=<
|
|
%+ verb |
|
|
%- agent:dbug
|
|
^- agent:gall
|
|
~% %hark-store-agent ..card ~
|
|
|_ =bowl:gall
|
|
+* this .
|
|
ha ~(. +> bowl)
|
|
def ~(. (default-agent this %|) bowl)
|
|
met ~(. metadata bowl)
|
|
gra ~(. graphl bowl)
|
|
::
|
|
++ on-init
|
|
:_ this
|
|
~[autoseen-timer]
|
|
::
|
|
++ on-save !>(-.state)
|
|
++ on-load
|
|
|= =old=vase
|
|
^- (quip card _this)
|
|
=/ old
|
|
!<(versioned-state old-vase)
|
|
=| cards=(list card)
|
|
|^
|
|
?- -.old
|
|
%1
|
|
[cards this(+.state (inflate-cache:ha old), -.state old)]
|
|
::
|
|
%0
|
|
|
|
%_ $
|
|
::
|
|
old
|
|
%* . *state-1
|
|
notifications (convert-notifications-1 notifications.old)
|
|
archive (convert-notifications-1 archive.old)
|
|
current-timebox current-timebox.old
|
|
dnd dnd.old
|
|
==
|
|
==
|
|
==
|
|
++ convert-notifications-1
|
|
|= old=notifications:state-zero:store
|
|
%+ gas:orm *notifications:store
|
|
^- (list [@da timebox:store])
|
|
%+ murn
|
|
(tap:orm:state-zero:store old)
|
|
|= [time=@da =timebox:state-zero:store]
|
|
^- (unit [@da timebox:store])
|
|
=/ new-timebox=timebox:store
|
|
(convert-timebox-1 timebox)
|
|
?: =(0 ~(wyt by new-timebox))
|
|
~
|
|
`[time new-timebox]
|
|
::
|
|
++ convert-timebox-1
|
|
|= =timebox:state-zero:store
|
|
^- timebox:store
|
|
%- ~(gas by *timebox:store)
|
|
^- (list [index:store notification:store])
|
|
%+ murn
|
|
~(tap by timebox)
|
|
|= [=index:state-zero:store =notification:state-zero:store]
|
|
^- (unit [index:store notification:store])
|
|
=/ new-index=(unit index:store)
|
|
(convert-index-1 index)
|
|
=/ new-notification=(unit notification:store)
|
|
(convert-notification-1 notification)
|
|
?~ new-index ~
|
|
?~ new-notification ~
|
|
`[u.new-index u.new-notification]
|
|
|
|
::
|
|
++ convert-index-1
|
|
|= =index:state-zero:store
|
|
^- (unit index:store)
|
|
?+ -.index `index
|
|
%chat ~
|
|
::
|
|
%graph
|
|
=, index
|
|
`[%graph group graph module description ~]
|
|
==
|
|
::
|
|
++ convert-notification-1
|
|
|= =notification:state-zero:store
|
|
^- (unit notification:store)
|
|
?: ?=(%chat -.contents.notification)
|
|
~
|
|
`notification
|
|
--
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?> (team:title [src our]:bowl)
|
|
|^
|
|
?+ path (on-watch:def path)
|
|
::
|
|
[%updates ~]
|
|
:_ this
|
|
[%give %fact ~ hark-update+!>(initial-updates)]~
|
|
==
|
|
::
|
|
++ initial-updates
|
|
^- update:store
|
|
:- %more
|
|
^- (list update:store)
|
|
:+ give-unreads
|
|
[%set-dnd dnd]
|
|
%+ weld
|
|
%+ turn
|
|
(tap-nonempty:ha archive)
|
|
(timebox-update &)
|
|
%+ turn
|
|
(tap-nonempty:ha notifications)
|
|
(timebox-update |)
|
|
::
|
|
++ give-since-unreads
|
|
^- (list [index:store index-stats:store])
|
|
%+ turn
|
|
~(tap by unreads-count)
|
|
|= [=index:store count=@ud]
|
|
?> ?=(%graph -.index)
|
|
:* index
|
|
~(wyt in (~(gut by by-index) index ~))
|
|
[%count count]
|
|
(~(gut by last-seen) index *time)
|
|
==
|
|
++ give-each-unreads
|
|
^- (list [index:store index-stats:store])
|
|
%+ turn
|
|
~(tap by unreads-each)
|
|
|= [=index:store indices=(set index:graph-store)]
|
|
:* index
|
|
~(wyt in (~(gut by by-index) index ~))
|
|
[%each indices]
|
|
(~(gut by last-seen) index *time)
|
|
==
|
|
::
|
|
++ give-unreads
|
|
^- update:store
|
|
:- %unreads
|
|
(weld give-each-unreads give-since-unreads)
|
|
::
|
|
++ timebox-update
|
|
|= archived=?
|
|
|= [time=@da =timebox:store]
|
|
^- update:store
|
|
[%timebox time archived ~(tap by timebox)]
|
|
--
|
|
::
|
|
++ on-peek
|
|
|= =path
|
|
^- (unit (unit cage))
|
|
?+ path (on-peek:def path)
|
|
::
|
|
[%x %recent ?(%archive %inbox) @ @ ~]
|
|
=/ is-archive
|
|
=(%archive i.t.t.path)
|
|
=/ offset=@ud
|
|
(slav %ud i.t.t.t.path)
|
|
=/ length=@ud
|
|
(slav %ud i.t.t.t.t.path)
|
|
:^ ~ ~ %hark-update
|
|
!> ^- update:store
|
|
:- %more
|
|
%+ turn
|
|
%+ scag length
|
|
%+ slag offset
|
|
%- tap-nonempty:ha
|
|
?:(is-archive archive notifications)
|
|
|= [time=@da =timebox:store]
|
|
^- update:store
|
|
:^ %timebox time is-archive
|
|
~(tap by timebox)
|
|
==
|
|
::
|
|
++ on-poke
|
|
~/ %hark-store-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
|^
|
|
?> (team:title our.bowl src.bowl)
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%hark-action (hark-action !<(action:store vase))
|
|
%noun ~& +.state [~ state]
|
|
==
|
|
[cards this]
|
|
::
|
|
++ hark-action
|
|
|= =action:store
|
|
^- (quip card _state)
|
|
|^
|
|
?- -.action
|
|
%add-note (add-note +.action)
|
|
%archive (do-archive +.action)
|
|
::
|
|
%read-each (read-each +.action)
|
|
%unread-each (unread-each +.action)
|
|
::
|
|
%read-count (read-count +.action)
|
|
%unread-count (unread-count +.action)
|
|
::
|
|
%read-note (read-note +.action)
|
|
%unread-note (unread-note +.action)
|
|
::
|
|
%read-all read-all
|
|
::
|
|
%set-dnd (set-dnd +.action)
|
|
%seen seen
|
|
==
|
|
::
|
|
++ add-note
|
|
|= [=index:store =notification:store]
|
|
^- (quip card _state)
|
|
=/ =timebox:store
|
|
(gut-orm:ha notifications current-timebox)
|
|
=/ existing-notif
|
|
(~(get by timebox) index)
|
|
=/ new=notification:store
|
|
?~ existing-notif
|
|
notification
|
|
(merge-notification:ha u.existing-notif notification)
|
|
=/ new-read=?
|
|
?~ existing-notif
|
|
%.y
|
|
read.u.existing-notif
|
|
=. read.new %.n
|
|
=/ new-timebox=timebox:store
|
|
(~(put by timebox) index new)
|
|
:- (give:ha [/updates]~ %added current-timebox index new)
|
|
%_ state
|
|
+ ?.(new-read +.state (upd-unreads:ha index current-timebox %.n))
|
|
notifications (put:orm notifications current-timebox new-timebox)
|
|
==
|
|
::
|
|
++ do-archive
|
|
|= [time=@da =index:store]
|
|
^- (quip card _state)
|
|
=/ =timebox:store
|
|
(gut-orm:ha notifications time)
|
|
=/ =notification:store
|
|
(~(got by timebox) index)
|
|
=/ new-timebox=timebox:store
|
|
(~(del by timebox) index)
|
|
:- (give:ha [/updates]~ %archive time index)
|
|
%_ state
|
|
+ ?.(read.notification (upd-unreads:ha index time %.y) +.state)
|
|
::
|
|
notifications
|
|
(put:orm notifications time new-timebox)
|
|
::
|
|
archive
|
|
%^ jub-orm:ha archive time
|
|
|= archive-box=timebox:store
|
|
^- timebox:store
|
|
(~(put by archive-box) index notification(read %.y))
|
|
==
|
|
::
|
|
++ unread-each
|
|
|= [=index:store unread=index:graph-store time=@da]
|
|
:- (give:ha ~[/updates] %unread-each index unread time)
|
|
%_ state
|
|
unreads-each
|
|
%+ jub index
|
|
|= indices=(set index:graph-store)
|
|
(~(put in indices) unread)
|
|
::
|
|
last-seen
|
|
(~(put by last-seen) index time)
|
|
==
|
|
::
|
|
++ jub
|
|
|= [=index:store f=$-((set index:graph-store) (set index:graph-store))]
|
|
^- (jug index:store index:graph-store)
|
|
=/ val=(set index:graph-store)
|
|
(~(gut by unreads-each) index ~)
|
|
(~(put by unreads-each) index (f val))
|
|
::
|
|
++ read-each
|
|
|= [=index:store ref=index:graph-store]
|
|
=/ to-dismiss=(list @da)
|
|
%+ skim
|
|
~(tap in (~(get ju by-index) index))
|
|
|= time=@da
|
|
=/ =timebox:store
|
|
(gut-orm notifications time)
|
|
=/ not=(unit notification:store)
|
|
(~(get by timebox) index)
|
|
?~ not %.n
|
|
?> ?=(%graph -.contents.u.not)
|
|
(lien list.contents.u.not |=(p=post:post =(index.p ref)))
|
|
=| cards=(list card)
|
|
|-
|
|
?^ to-dismiss
|
|
=^ crds state
|
|
(read-note i.to-dismiss index)
|
|
$(cards (weld cards crds), to-dismiss t.to-dismiss)
|
|
:- (weld cards (give:ha ~[/updates] %read-each index ref))
|
|
%_ state
|
|
::
|
|
unreads-each
|
|
%+ jub index
|
|
|= indices=(set index:graph-store)
|
|
(~(del in indices) ref)
|
|
==
|
|
::
|
|
++ read-note
|
|
|= [time=@da =index:store]
|
|
^- (quip card _state)
|
|
:- (give:ha [/updates]~ %read-note time index)
|
|
%_ state
|
|
+ (upd-unreads:ha index time %.y)
|
|
notifications (change-read-status:ha time index %.y)
|
|
==
|
|
::
|
|
++ unread-note
|
|
|= [time=@da =index:store]
|
|
^- (quip card _state)
|
|
:- (give:ha [/updates]~ %unread-note time index)
|
|
%_ state
|
|
+ (upd-unreads:ha index time %.n)
|
|
notifications (change-read-status:ha time index %.n)
|
|
==
|
|
::
|
|
++ read-count
|
|
|= =index:store
|
|
^- (quip card _state)
|
|
=^ cards state
|
|
(read-index index)
|
|
:- %+ weld cards
|
|
(give:ha [/updates]~ %read-count index)
|
|
%_ state
|
|
unreads-count (~(put by unreads-count) index 0)
|
|
==
|
|
::
|
|
++ read-boxes
|
|
|= [boxes=(set @da) =index:store]
|
|
^- (quip card _state)
|
|
=/ boxes=(list @da)
|
|
~(tap in boxes)
|
|
=| crds=(list card)
|
|
|-
|
|
?~ boxes [crds state]
|
|
=* box i.boxes
|
|
=^ cards state
|
|
(read-note box index)
|
|
$(boxes t.boxes, crds (welp crds cards))
|
|
::
|
|
++ read-index
|
|
|= =index:store
|
|
^- (quip card _state)
|
|
=/ boxes=(set @da)
|
|
(~(get ju by-index) index)
|
|
=^ cards state
|
|
(read-boxes boxes index)
|
|
:_ state
|
|
%+ welp cards
|
|
(give:ha ~[/updates] %read-index index)
|
|
::
|
|
++ read-all
|
|
^- (quip card _state)
|
|
`state
|
|
::
|
|
++ unread-count
|
|
|= [=index:store time=@da]
|
|
^- (quip card _state)
|
|
:- (give:ha [/updates]~ %unread-count index time)
|
|
=/ curr=@ud
|
|
(~(gut by unreads-count) index 0)
|
|
%_ state
|
|
last-seen (~(put by last-seen) index time)
|
|
unreads-count (~(put by unreads-count) index +(curr))
|
|
==
|
|
::
|
|
++ seen
|
|
^- (quip card _state)
|
|
:_ state(current-timebox now.bowl)
|
|
:~ cancel-autoseen:ha
|
|
autoseen-timer:ha
|
|
==
|
|
::
|
|
++ set-dnd
|
|
|= d=?
|
|
^- (quip card _state)
|
|
:_ state(dnd d)
|
|
(give:ha [/updates]~ %set-dnd d)
|
|
--
|
|
--
|
|
::
|
|
++ on-agent on-agent:def
|
|
::
|
|
++ on-leave on-leave:def
|
|
++ on-arvo
|
|
|= [=wire =sign-arvo]
|
|
^- (quip card _this)
|
|
?. ?=([%autoseen ~] wire)
|
|
(on-arvo:def wire sign-arvo)
|
|
?> ?=([%behn %wake *] sign-arvo)
|
|
:_ this(current-timebox now.bowl)
|
|
~[autoseen-timer:ha]
|
|
::
|
|
++ on-fail on-fail:def
|
|
--
|
|
|_ =bowl:gall
|
|
+* met ~(. metadata bowl)
|
|
::
|
|
++ merge-notification
|
|
|= [existing=notification:store new=notification:store]
|
|
^- notification:store
|
|
?- -.contents.existing
|
|
::
|
|
%graph
|
|
?> ?=(%graph -.contents.new)
|
|
existing(read %.n, list.contents (weld list.contents.existing list.contents.new))
|
|
::
|
|
%group
|
|
?> ?=(%group -.contents.new)
|
|
existing(read %.n, list.contents (weld list.contents.existing list.contents.new))
|
|
==
|
|
::
|
|
++ change-read-status
|
|
|= [time=@da =index:store read=?]
|
|
^+ notifications
|
|
%^ jub-orm notifications time
|
|
|= =timebox:store
|
|
%+ ~(jab by timebox) index
|
|
|= =notification:store
|
|
?> !=(read read.notification)
|
|
notification(read read)
|
|
:: +key-orm: +key:by for ordered maps
|
|
++ key-orm
|
|
|= =notifications:store
|
|
^- (list @da)
|
|
(turn (tap:orm notifications) |=([key=@da =timebox:store] key))
|
|
:: +jub-orm: combo +jab/+gut for ordered maps
|
|
:: TODO: move to zuse.hoon
|
|
++ jub-orm
|
|
|= [=notifications:store time=@da fun=$-(timebox:store timebox:store)]
|
|
^- notifications:store
|
|
=/ =timebox:store
|
|
(fun (gut-orm notifications time))
|
|
(put:orm notifications time timebox)
|
|
:: +gut-orm: +gut:by for ordered maps
|
|
:: TODO: move to zuse.hoon
|
|
++ gut-orm
|
|
|= [=notifications:store time=@da]
|
|
^- timebox:store
|
|
(fall (get:orm notifications time) ~)
|
|
::
|
|
++ autoseen-interval ~h3
|
|
++ cancel-autoseen
|
|
^- card
|
|
[%pass /autoseen %arvo %b %rest (add current-timebox autoseen-interval)]
|
|
::
|
|
++ autoseen-timer
|
|
^- card
|
|
[%pass /autoseen %arvo %b %wait (add now.bowl autoseen-interval)]
|
|
::
|
|
++ scry
|
|
|* [=mold p=path]
|
|
?> ?=(^ p)
|
|
?> ?=(^ t.p)
|
|
.^(mold i.p (scot %p our.bowl) i.t.p (scot %da now.bowl) t.t.p)
|
|
::
|
|
++ give
|
|
|= [paths=(list path) update=update:store]
|
|
^- (list card)
|
|
[%give %fact paths [%hark-update !>(update)]]~
|
|
::
|
|
++ upd-unreads
|
|
|= [=index:store time=@da read=?]
|
|
^+ +.state
|
|
%_ +.state
|
|
::
|
|
by-index
|
|
%. [index time]
|
|
?: read
|
|
~(del ju by-index)
|
|
~(put ju by-index)
|
|
==
|
|
::
|
|
++ group-for-index
|
|
|= =index:store
|
|
^- (unit resource)
|
|
?. ?=(%graph -.index)
|
|
~
|
|
`group.index
|
|
::
|
|
++ give-dirtied-unreads
|
|
|= [=index:store =update:store]
|
|
^- (list card)
|
|
=/ group
|
|
(group-for-index index)
|
|
?~ group ~
|
|
(give ~[group+(en-path:resource u.group)] update)
|
|
::
|
|
++ tap-nonempty
|
|
|= =notifications:store
|
|
^- (list [@da timebox:store])
|
|
%+ skim (tap:orm notifications)
|
|
|=([@da =timebox:store] !=(~(wyt by timebox) 0))
|
|
::
|
|
++ inflate-cache
|
|
|= state-1
|
|
^+ +.state
|
|
=/ nots=(list [p=@da =timebox:store])
|
|
(tap:orm notifications)
|
|
|- =* outer $
|
|
?~ nots
|
|
+.state
|
|
=/ unreads ~(tap by timebox.i.nots)
|
|
|- =* inner $
|
|
?~ unreads
|
|
outer(nots t.nots)
|
|
=* notification q.i.unreads
|
|
=* index p.i.unreads
|
|
?: read.notification
|
|
inner(unreads t.unreads)
|
|
=. +.state
|
|
(upd-unreads index p.i.nots %.n)
|
|
inner(unreads t.unreads)
|
|
--
|