garden: rework hark-store timeboxing

This commit is contained in:
Liam Fitzgerald 2021-09-17 10:44:35 +10:00
parent a433e4f911
commit 1d94d08d60
6 changed files with 228 additions and 134 deletions

View File

@ -25,7 +25,7 @@
--
^- agent:gall
%- agent:dbug
%+ verb &
%+ verb |
=| inflated-state
=* state -
=<

View File

@ -29,9 +29,10 @@
::
+$ base-state
$: places=(map place:store stats:store)
=unreads:store
=reads:store
current-timebox=@da
seen=timebox:store
unseen=timebox:store
=archive:store
half-open=(map bin:store @da)
==
::
+$ state-2
@ -57,7 +58,7 @@
::
::
+$ cached-state
$: by-place=(jug place:store [time=(unit @da) =path])
$: by-place=(jug place:store [=lid:store =path])
~
==
+$ inflated-state
@ -70,7 +71,7 @@
=* state -
::
=<
%+ verb |
%+ verb &
%- agent:dbug
^- agent:gall
~% %hark-store-agent ..card ~
@ -99,22 +100,21 @@
::
:_ this
(poke-our:pass %hark-graph-hook hark-graph-migrate+old-vase)^~
::
++ index-timebox
|= [time=(unit @da) =timebox:store out=_by-place]
|= [=lid:store =timebox:store out=_by-place]
^+ by-place
%+ roll ~(tap by timebox)
|= [[=bin:store =notification:store] out=_out]
(~(put ju out) place.bin [time path.bin])
::
++ index-reads
^+ by-place
%+ roll (tap:orm reads)
|= [[=time =timebox:store] out=_by-place]
(index-timebox `time timebox out)
(~(put ju out) place.bin [lid path.bin])
::
++ inflate
=. by-place index-reads
=. by-place (index-timebox ~ unreads by-place)
=. by-place (index-timebox seen+~ seen by-place)
=. by-place (index-timebox unseen+~ unseen by-place)
=. by-place
%+ roll (tap:orm archive)
|= [[=time =timebox:store] out=_by-place]
(index-timebox archive/time timebox out)
+.state
--
::
@ -136,7 +136,8 @@
^- update:store
:- %more
^- (list update:store)
:~ [%timebox ~ ~(tap by unreads)]
:~ [%timebox unseen+~ ~(val by unseen)]
[%timebox seen+~ ~(val by seen)]
[%all-stats places]
==
--
@ -154,10 +155,10 @@
:^ ~ ~ %hark-update
!> ^- update:store
:- %more
%+ turn (tab:orm reads `date length)
%+ turn (tab:orm archive `date length)
|= [time=@da =timebox:store]
^- update:store
[%timebox `time ~(tap by timebox)]
[%timebox archive+time ~(val by timebox)]
==
::
++ on-poke
@ -177,7 +178,7 @@
|= val=*
?+ val ~|(%bad-noun-poke !!)
%print ~&(+.state [~ state])
%clear `state(unreads ~, reads ~)
%clear [~ state(. *inflated-state)]
==
::
++ poke-us
@ -213,6 +214,7 @@
::
++ abed
|= in=action:store
^+ poke-core
?- -.in
::
%add-note (add-note +.in)
@ -227,11 +229,10 @@
::
%read-note (read-note +.in)
::
%seen-index (seen-index +.in)
%saw-place (saw-place +.in)
::
%seen seen
%opened opened
%archive-all archive-all
%read-all read-all
::
==
::
@ -250,7 +251,31 @@
:: notification tracking
++ put-notifs
|= [time=@da =timebox:store]
poke-core(reads (put:orm reads time timebox))
poke-core(archive (put:orm archive time timebox))
::
++ put-lid
|= [=lid:store =bin:store =notification:store]
^+ poke-core
=. by-place (~(put ju by-place) place.bin [lid path.bin])
?- -.lid
%seen
poke-core(seen (~(put by seen) bin notification))
::
%unseen
poke-core(unseen (~(put by unseen) bin notification))
::
%archive
poke-core(archive (~(put re archive) time.lid bin notification))
==
::
++ del-lid
|= [=lid:store =bin:store]
=. by-place (~(del ju by-place) place.bin [lid path.bin])
?- -.lid
%seen poke-core(seen (~(del by seen) bin))
%unseen poke-core(unseen (~(del by unseen) bin))
%archive poke-core(archive (~(del re archive) time.lid bin))
==
::
++ add-note
|= [=bin:store =body:store]
@ -258,54 +283,55 @@
=. poke-core
(emit (fact:io hark-update+!>([%add-note bin body]) /notes ~))
=. by-place
(~(put ju by-place) place.bin ~ path.bin)
(~(put ju by-place) place.bin unseen+~ path.bin)
=/ existing-notif
(~(gut by unreads) bin *notification:store)
(~(gut by unseen) bin *notification:store)
=/ new=notification:store
[now.bowl bin (snoc body.existing-notif body)]
=. unreads
(~(put by unreads) bin new)
[now.bowl bin [body body.existing-notif]]
=. unseen
(~(put by unseen) bin new)
(give %added new)
::
++ del-place
|= =place:store
=/ notes=(list [time=(unit @da) =path])
=. poke-core (give %del-place place)
=/ notes=(list [=lid:store =path])
~(tap in (~(get ju by-place) place))
|- ^+ poke-core
?~ notes poke-core
=/ core=_poke-core
(do-archive time.i.notes [path.i.notes place])
$(poke-core core, notes t.notes)
=, i.notes
=. poke-core
(del-lid lid path place)
$(notes t.notes)
::
++ do-archive
|= [time=(unit @da) =bin:store]
|= [=lid:store =bin:store]
^+ poke-core
=. poke-core (give %archive time bin)
|^
?~(time archive-unread (archive-read u.time))
::
++ archive-unread
=. by-place (~(del ju by-place) place.bin ~ path.bin)
poke-core(unreads (~(del by unreads) bin))
::
++ archive-read
|= time=@da
%_ poke-core
by-place (~(del ju by-place) place.bin `time path.bin)
reads (~(del re reads) time bin)
==
--
~| %already-archived
?< ?=(%time -.lid)
~| %non-existent
=/ =notification:store (need (get-lid lid bin))
=. poke-core (del-lid lid bin)
=. poke-core (put-lid archive+now.bowl bin notification)
=? poke-core ?=(%unseen -.lid)
?~ n=(get-lid seen+~ bin) poke-core
=. archive
%^ ~(job re archive) now.bowl bin
|= og=(unit notification:store)
(merge-notification og u.n)
poke-core
(give %archived now.bowl lid notification)
::
++ read-note
|= =bin:store
=/ =notification:store
(~(got by unreads) bin)
=. unreads
(~(del by unreads) bin)
(~(got by unseen) bin)
=. unseen
(~(del by unseen) bin)
=/ =time
(fall timebox:(gut-place place.bin) now.bowl)
=. date.notification time
=. reads (~(put re reads) time bin notification)
=. archive (~(put re archive) time bin notification)
(give %note-read time bin)
::
::
@ -315,7 +341,7 @@
::
++ unread-each
|= [=place:store =path]
=. poke-core (seen-index place ~)
=. poke-core (saw-place place ~)
=. poke-core (give %unread-each place path)
%+ jub-place place
|=(=stats:store stats(each (~(put in each.stats) path)))
@ -324,11 +350,11 @@
|= [=place:store =path]
%- read-bins
%+ skim
~(tap in ~(key by unreads))
~(tap in ~(key by unseen))
|= =bin:store
?. =(place place.bin) %.n
=/ not=notification:store
(~(got by unreads) bin)
(~(got by unseen) bin)
(lien body.not |=(=body:store =(binned.body path)))
::
++ read-each
@ -361,7 +387,7 @@
|= [=place:store inc=? count=@ud]
=. poke-core
(give %unread-count place inc count)
=. poke-core (seen-index place ~)
=. poke-core (saw-place place ~)
=/ f
?: inc (cury add count)
(curr sub count)
@ -369,9 +395,36 @@
|= =stats:store
stats(count (f count.stats))
::
++ half-archive
|= =place:store
=/ bins=(list [=lid:store =path])
~(tap in (~(get ju by-place) place))
|-
?~ bins poke-core
=/ =bin:store
[path.i.bins place]
=* lid lid.i.bins
?: ?=(%archive -.lid)
$(bins t.bins)
=/ seen-place (~(get by seen) bin)
=/ n=(unit notification:store) (get-lid lid bin)
?~ n $(bins t.bins)
=* note u.n
=/ =time (~(gut by half-open) bin now.bowl)
=? half-open !(~(has by half-open) bin)
(~(put by half-open) bin now.bowl)
=. archive
%^ ~(job re archive) time bin
|=(n=(unit notification:store) (merge-notification n note))
=. by-place (~(put ju by-place) place [archive/now.bowl path.bin])
=. poke-core (give %archived now.bowl unseen+~ (~(got re archive) time bin))
=. poke-core (give %archived now.bowl seen+~ (~(got re archive) time bin))
$(bins t.bins)
::
++ read-count
|= =place:store
=. poke-core (give %read-count place)
=. poke-core (half-archive place)
%+ jub-place place
|= =stats:store
stats(count 0, timebox `now.bowl)
@ -384,29 +437,33 @@
(read-note i.bins)
$(poke-core core, bins t.bins)
::
++ seen-index
++ saw-place
|= [=place:store time=(unit time)]
=. poke-core (give %seen-index place time)
=. poke-core (give %saw-place place time)
%+ jub-place place
|=(=stats:store stats(last (fall time now.bowl)))
::
++ seen
=. poke-core
(read-bins ~(tap in ~(key by unreads)))
++ archive-seen
=/ seen=(list [=bin:store =notification:store]) ~(tap by seen)
poke-core
::
++ opened
=. seen
%- ~(gas by *timebox:store)
%+ murn ~(tap in (~(uni in ~(key by seen)) ~(key by unseen)))
|= =bin:store
=/ se (~(get by seen) bin)
=/ un (~(get by unseen) bin)
?~ un
?~(se ~ `[bin u.se])
`[bin (merge-notification se u.un)]
=. unseen ~
=. poke-core (turn-places |=(=stats:store stats(timebox ~)))
poke-core(current-timebox now.bowl)
(give %opened ~)
::
++ archive-all
=. poke-core (give:seen %archive-all ~)
poke-core(unreads ~, reads ~)
::
++ read-all
=. poke-core (give:seen %read-all ~)
=/ to-read=(list bin:store) ~(tap in ~(key by unreads))
|-
?~ to-read poke-core
=/ core=_poke-core (read-note i.to-read)
$(to-read t.to-read, poke-core core)
(give:opened %archive-all ~)
::
++ turn-places
|= f=$-(stats:store stats:store)
@ -417,24 +474,29 @@
$(poke-core core, places t.places)
--
::
++ get-lid
|= [=lid:store =bin:store]
=/ =timebox:store ?:(?=(%unseen -.lid) unseen seen)
(~(get by timebox) bin)
::
++ merge-notification
|= [existing=(unit notification:store) new=notification:store]
^- notification:store
?~ existing new
[(max date.u.existing date.new) bin.new (welp body.u.existing body.new)]
[(max date.u.existing date.new) bin.new (welp body.new body.u.existing)]
::
:: +key-orm: +key:by for ordered maps
++ key-orm
|= =reads:store
|= =archive:store
^- (list @da)
(turn (tap:orm reads) |=([@da *] +<-))
(turn (tap:orm archive) |=([@da *] +<-))
::
:: +gut-orm: +gut:by for ordered maps
:: TODO: move to zuse.hoon
++ gut-orm
|= [=reads:store time=@da]
|= [=archive:store time=@da]
^- timebox:store
(fall (get:orm reads time) ~)
(fall (get:orm archive time) ~)
::
::
++ scry
@ -449,8 +511,8 @@
[%give %fact paths [%hark-update !>(update)]]~
::
++ tap-nonempty
|= =reads:store
|= =archive:store
^- (list [@da timebox:store])
%+ skim (tap:orm reads)
%+ skim (tap:orm archive)
|=([@da =timebox:store] !=(~(wyt by timebox) 0))
--

View File

@ -120,7 +120,7 @@
++ body
|= [=path title=cord content=cord]
^- body:hark
[~[text+title] ~[text+content] now.bowl path ~]
[~[text+title] ~[text+content] now.bowl ~ path]
::
::
++ title-prefix
@ -134,7 +134,7 @@
++ updated
^- action:hark
:+ %add-note [/update place]
%^ body /updated (title-prefix ' has been updated')
%^ body /desk/[desk] (title-prefix ' has been updated')
?: has-docket
(rap 3 'Version: ' (ver version:docket) ~)
(rap 3 'Hash: ' (scot %uv hash) ~)
@ -150,6 +150,7 @@
|= =version:^docket
=, version
`@t`(rap 3 (num major) '.' (num minor) '.' (num patch) ~)
::
++ num
|= a=@ud
`@t`(rsh 4 (scot %ui a))

View File

@ -14,31 +14,40 @@
%+ frond -.upd
?+ -.upd a+~
%added (notification +.upd)
%add-note (add-note +.upd)
%timebox (timebox +.upd)
%more (more +.upd)
%read-each (read-each +.upd)
%read-count (place +.upd)
%unread-each (read-each +.upd)
%unread-count (unread-count +.upd)
%seen-index (seen-index +.upd)
%saw-place (saw-place +.upd)
%all-stats (all-stats +.upd)
::%read-note (index +.upd)
::%note-read (note-read +.upd)
%archive (archive +.upd)
%archived (archived +.upd)
==
::
++ seen-index
++ add-note
|= [bi=^bin bo=^body]
%- pairs
:~ bin+(bin bi)
body+(body bo)
==
::
++ saw-place
|= [p=^place t=(unit ^time)]
%- pairs
:~ place+(place p)
time+?~(t ~ (time u.t))
==
::
++ archive
|= [t=(unit @da) b=^bin]
++ archived
|= [t=^time l=^lid n=^notification]
%- pairs
:~ time+?~(t ~ s+(scot %ud u.t))
bin+(bin b)
:~ lid+(lid l)
time+s+(scot %ud t)
notification+(notification n)
==
::
++ note-read
@ -88,7 +97,7 @@
|= ^notification
^- json
%- pairs
:~ time+s+(scot %ud date)
:~ time+(time date)
bin+(^bin bin)
body+(bodies body)
==
@ -117,7 +126,7 @@
%- pairs
:~ title+(contents title)
content+(contents content)
time+s+(scot %ud time)
time+(^time time)
link+s+(spat link)
==
::
@ -127,19 +136,21 @@
:~ bin+(^bin bin)
notification+(^notification notification)
==
++ lid
|= l=^lid
^- json
%+ frond -.l
?- -.l
?(%seen %unseen) ~
%archive s+(scot %ud time.l)
==
::
++ timebox
|= [tim=(unit @da) l=(list [^bin ^notification])]
|= [li=^lid l=(list ^notification)]
^- json
%- pairs
:~ time+`json`?~(tim ~ s+(scot %ud u.tim))
:- %notifications
^- json
:- %a
%+ turn l
|= [=^bin =^notification]
^- json
(binned-notification bin notification)
:~ lid+(lid li)
notifications+a+(turn l notification)
==
::
++ read-each
@ -161,6 +172,14 @@
++ dejs
=, dejs:format
|%
:: TODO: fix +stab
::
++ pa
|= j=json
^- path
?> ?=(%s -.j)
?: =('/' p.j) /
(stab p.j)
::
++ place
%- ot
@ -187,19 +206,26 @@
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
::
++ lid
%- of
:~ archive+sd
unseen+ul
seen+ul
==
::
++ archive
%- ot
:~ time+(mu sd)
:~ lid+lid
bin+bin
==
::
++ action
^- $-(json ^action)
%- of
:~ read-all+ul
archive-all+ul
seen+ul
:~ archive-all+ul
archive+archive
opened+ul
read-count+place
read-each+read-each
read-note+bin

View File

@ -1,20 +1,20 @@
/+ store=hark-store
|_ =reads:store
|_ =archive:store
++ orm ((on @da timebox:store) gth)
++ del
|= [=time =bin:store]
?~ box=(get:orm reads time) reads
(put:orm reads time (~(del by u.box) bin))
?~ box=(get:orm archive time) archive
(put:orm archive time (~(del by u.box) bin))
++ put
|= [=time =bin:store =notification:store]
=/ box=timebox:store (fall (get:orm reads time) ~)
=/ box=timebox:store (fall (get:orm archive time) ~)
=. box (~(put by box) bin notification)
(put:orm reads time box)
(put:orm archive time box)
::
++ get
|= [=time =bin:store]
^- (unit notification:store)
?~ box=(get:orm reads time) ~
?~ box=(get:orm archive time) ~
(~(get by u.box) bin)
::
++ got

View File

@ -56,6 +56,14 @@
:: [/comment %landscape /~darrux-landes/feature-requests/12374893234232/2]
::
+$ bin [=path =place]
::
:: $lid: Reference to a timebox
::
+$ lid
$% [%archive =time]
[%seen ~]
[%unseen ~]
==
:: $content: Notification content
+$ content
$% [%ship =ship]
@ -74,21 +82,19 @@
::
+$ notification
[date=@da =bin body=(list body)]
:: $timebox: Read notifications from a particular time
:: $timebox: Group of notificatons
+$ timebox
(map bin notification)
:: $reads: Read notifications, ordered by time
+$ reads
:: $archive: Archived notifications, ordered by time
+$ archive
((mop @da timebox) gth)
:: +unreads: Unread notifications
+$ unreads
(map bin notification)
::
+$ action
$% :: hook actions
::
:: %add-note: add a notification
[%add-note =bin =body]
::
:: %del-place: Underlying resource disappeared, remove all
:: associated notifications
[%del-place =place]
@ -96,14 +102,14 @@
[%unread-count =place inc=? count=@ud]
:: %unread-each: Add .path to list of unreads for .place
[%unread-each =place =path]
:: %seen-index: Update last-updated for .place to now.bowl
[%seen-index =place time=(unit time)]
:: %saw-place: Update last-updated for .place to now.bowl
[%saw-place =place time=(unit time)]
:: store actions
::
:: %archive: archive single notification
:: if .time is ~, then archiving unread notification
:: else, archiving read notification
[%archive time=(unit @da) =bin]
[%archive =lid =bin]
:: %read-count: set unread count to zero
[%read-count =place]
:: %read-each: remove path from unreads for .place
@ -112,18 +118,17 @@
[%read-note =bin]
:: %archive-all: Archive all notifications
[%archive-all ~]
:: %read-all: Read all all notifications
[%read-all ~]
:: %seen: User opened notifications, reset timeboxing logic.
[%seen ~]
::
:: XX: previously in hark-store, now deprecated
:: the hooks responsible for creating notifications may offer pokes
:: similar to this
:: [%read-graph =resource]
:: [%read-group =resource]
:: [%remove-graph =resource]
::
:: %opened: User opened notifications, reset timeboxing logic.
::
[%opened ~]
::
:: XX: previously in hark-store, now deprecated
:: the hooks responsible for creating notifications may offer pokes
:: similar to this
:: [%read-graph =resource]
:: [%read-group =resource]
:: [%remove-graph =resource]
::
==
:: .stats: Statistics for a .place
::
@ -137,14 +142,14 @@
+$ update
$% action
:: %more: more updates
[%archived =time =lid =notification]
[%more more=(list update)]
:: %note-read: note has been read with timestamp
[%note-read =time =bin]
[%added =notification]
:: %timebox: description of timebox.
::
:: If time is ~, this is the unread timebox
[%timebox time=(unit @da) =(list [bin notification])]
[%timebox =lid =(list notification)]
:: %place-stats: description of .stats for a .place
[%place-stats =place =stats]
:: %place-stats: stats for all .places