hark,settings: ripping out old hark, renaming settings

This commit is contained in:
Hunter Miller 2023-04-12 15:37:00 -05:00
parent 39cac10d78
commit 4419b5cd5e
7 changed files with 1 additions and 1412 deletions

View File

@ -1,550 +0,0 @@
:: 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
::
/- store=hark-store
/+ verb, dbug, default-agent, re=hark-unreads, agentio
::
::
~% %hark-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-2
state-3
state-4
state-5
state-6
state-7
state-8
state-9
==
::
+$ base-state
$: places=(map place:store stats:store)
seen=timebox:store
unseen=timebox:store
=archive:store
half-open=(map bin:store @da)
==
::
+$ state-2
[%2 *]
::
+$ state-3
[%3 *]
::
+$ state-4
[%4 *]
::
+$ state-5
[%5 *]
::
+$ state-6
[%6 *]
::
+$ state-7
[%7 *]
::
+$ state-8
[%8 base-state]
::
+$ state-9
[%9 base-state]
::
::
+$ cached-state
$: by-place=(jug place:store [=lid:store =path])
~
==
+$ inflated-state
[state-9 cached-state]
::
++ 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)
io ~(. agentio bowl)
pass pass:io
::
++ on-init
`this
::
++ on-save !>(-.state)
++ on-load
|= =old=vase
=/ old
!<(versioned-state old-vase)
=| cards=(list card)
|- ^- (quip card _this)
?+ -.old
:: pre-dist migration
:_ this
(poke-our:pass %hark-graph-hook hark-graph-migrate+old-vase)^~
::
%9
=. -.state old
=. +.state inflate:ha
:_(this (flop cards))
::
%8
$(-.old %9, archive.old *archive:store)
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [src our]:bowl)
|^
?+ path (on-watch:def path)
[%notes ~] `this
::
[%updates ~]
:_ this
[%give %fact ~ hark-update+!>(initial-updates)]~
::
==
::
++ initial-updates
^- update:store
:- %more
^- (list update:store)
:~ [%timebox unseen+~ ~(val by unseen)]
[%timebox seen+~ ~(val by seen)]
[%all-stats places]
==
--
::
++ on-peek
~/ %hark-store-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
::
[%x %recent %inbox @ @ ~]
=/ date=@da
(slav %ud i.t.t.t.path)
=/ length=@ud
(slav %ud i.t.t.t.t.path)
:^ ~ ~ %hark-update
!> ^- update:store
:- %more
%+ turn (tab:orm archive `date length)
|= [time=@da =timebox:store]
^- update:store
[%timebox archive+time ~(val by timebox)]
::
[%x %all-stats ~]
:^ ~ ~ %hark-update
!> ^- update:store
:- %more
^- (list update:store)
:~ [%all-stats places]
==
==
::
++ 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 (poke-noun !<(* vase))
==
[cards this]
::
++ poke-noun
|= val=*
?+ val ~|(%bad-noun-poke !!)
%print ~&(+.state [~ state])
%clear [~ state(. *inflated-state)]
%sane
~& +.state
~& inflate
?>(=(+.state inflate) `state)
==
::
++ poke-us
|= =action:store
^- card
[%pass / %agent [our dap]:bowl %poke hark-action+!>(action)]
::
++ hark-action
|= =action:store
^- (quip card _state)
abet:(abed:poke-engine:ha action)
--
::
++ 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)
`this
::
++ on-fail on-fail:def
--
|_ =bowl:gall
+* met ~(. metadata bowl)
io ~(. agentio bowl)
pass pass:io
++ poke-engine
|_ [out=(list update:store) cards=(list card)]
++ poke-core .
::
++ abed
|= in=action:store
^+ poke-core
?- -.in
::
%add-note (add-note +.in)
%del-place (del-place +.in)
%archive (do-archive +.in)
::
%unread-count (unread-count +.in)
%read-count (read-count +.in)
::
%read-each (read-each +.in)
%unread-each (unread-each +.in)
::
%read-note (read-note +.in)
::
%saw-place (saw-place +.in)
::
%opened opened
%archive-all archive-all
::
==
::
++ abet
^- (quip card _state)
:_ state
%+ snoc (flop cards)
[%give %fact ~[/updates] %hark-update !>([%more (flop out)])]
::
++ give |=(=update:store poke-core(out [update out]))
++ emit |=(=card poke-core(cards [card cards]))
::
::
:: +| %note
::
:: notification tracking
++ put-notifs
|= [time=@da =timebox:store]
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]
^+ poke-core
=. poke-core
(emit (fact:io hark-update+!>([%add-note bin body]) /notes ~))
=/ existing-notif
(~(gut by unseen) bin *notification:store)
=/ new=notification:store
[now.bowl bin [body body.existing-notif]]
=. poke-core
(put-lid unseen/~ bin new)
(give %added new)
::
++ del-place
|= =place:store
=. poke-core (give %del-place place)
=/ notes=(list [=lid:store =path])
~(tap in (~(get ju by-place) place))
|- ^+ poke-core
?~ notes poke-core
=, i.notes
=. poke-core
(del-lid lid path place)
$(notes t.notes)
::
++ do-archive
|= [=lid:store =bin:store]
^+ poke-core
~| %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)
(give %archived now.bowl lid notification)
::
++ read-note
|= =bin:store
=/ =notification:store
(~(got by unseen) bin)
=. poke-core
(del-lid unseen/~ bin)
=/ =time
(fall timebox:(gut-place place.bin) now.bowl)
=. date.notification time
=. poke-core
(put-lid archive/time bin notification)
(give %note-read time bin)
::
::
:: +| %each
::
:: each unread tracking
::
++ unread-each
|= [=place:store =path]
=. poke-core (saw-place place ~)
=. poke-core (give %unread-each place path)
%+ jub-place place
|=(=stats:store stats(each (~(put in each.stats) path)))
::
++ read-index-each
|= [=place:store =path]
%- read-bins
%+ skim
~(tap in ~(key by unseen))
|= =bin:store
?. =(place place.bin) %.n
=/ not=notification:store
(~(got by unseen) bin)
(lien body.not |=(=body:store =(binned.body path)))
::
++ read-each
|= [=place:store =path]
=. poke-core (read-index-each place path)
=. poke-core (give %read-each place path)
%+ jub-place place
|= =stats:store
%_ stats
timebox `now.bowl
each (~(del in each.stats) path)
==
::
++ gut-place
|= =place:store
?: (~(has by places) place) (~(got by places) place)
=| def=stats:store
def(timebox ~, last now.bowl)
::
++ jub-place
|= $: =place:store
f=$-(stats:store stats:store)
==
^+ poke-core
=/ =stats:store
(gut-place place)
poke-core(places (~(put by places) place (f stats)))
::
++ unread-count
|= [=place:store inc=? count=@ud]
=. poke-core
(give %unread-count place inc count)
=. poke-core (saw-place place ~)
=/ f
?: inc (cury add count)
(curr sub count)
%+ jub-place place
|= =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)
=/ existing (get-lid archive/time bin)
=/ new (merge-notification existing note)
=? half-open (lth 30 (lent body.new))
(~(del by half-open) bin)
=. poke-core
(put-lid archive/time bin new)
=. poke-core (del-lid lid bin)
=. poke-core (give %archived time lid (~(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)
::
++ read-bins
|= bins=(list bin:store)
|-
?~ bins poke-core
=/ core
(read-note i.bins)
$(poke-core core, bins t.bins)
::
++ saw-place
|= [=place:store time=(unit time)]
=. poke-core (give %saw-place place time)
%+ jub-place place
|=(=stats:store stats(last (fall time now.bowl)))
::
++ archive-seen
=/ seen=(list [=bin:store =notification:store]) ~(tap by seen)
poke-core
::
++ opened
=. poke-core (turn-places |=(=stats:store stats(timebox ~)))
=. poke-core (give %opened ~)
%+ roll ~(tap in ~(key by unseen))
|= [=bin:store out=_poke-core]
(opened-note:out bin)
::
++ opened-note
|= =bin:store
^+ poke-core
=/ old
(~(got by unseen) bin)
=. poke-core
(del-lid unseen/~ bin)
=/ se (~(get by seen) bin)
%^ put-lid seen/~ bin
(merge-notification se old)
::
++ archive-all
|^
=. poke-core (archive-lid unseen/~ unseen)
(archive-lid seen/~ seen)
++ archive-lid
|= [=lid:store =timebox:store]
%+ roll ~(tap in ~(key by timebox))
|= [=bin:store out=_poke-core]
(do-archive:out lid bin)
--
::
++ turn-places
|= f=$-(stats:store stats:store)
=/ places ~(tap in ~(key by places))
|- ^+ poke-core
?~ places poke-core
=/ core=_poke-core (jub-place i.places f)
$(poke-core core, places t.places)
--
::
++ get-lid
|= [=lid:store =bin:store]
=; =timebox:store
(~(get by timebox) bin)
?- -.lid
%unseen unseen
%seen seen
%archive (fall (get:orm archive time.lid) *timebox:store)
==
::
++ merge-notification
|= [existing=(unit notification:store) new=notification:store]
^- notification:store
?~ existing new
[(max date.u.existing date.new) bin.new (welp body.new body.u.existing)]
::
:: +key-orm: +key:by for ordered maps
++ key-orm
|= =archive:store
^- (list @da)
(turn (tap:orm archive) |=([@da *] +<-))
::
:: +gut-orm: +gut:by for ordered maps
:: TODO: move to zuse.hoon
++ gut-orm
|= [=archive:store time=@da]
^- timebox:store
(fall (get:orm archive time) ~)
::
::
++ 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)]]~
::
++ tap-nonempty
|= =archive:store
^- (list [@da timebox:store])
%+ skim (tap:orm archive)
|=([@da =timebox:store] !=(~(wyt by timebox) 0))
::
++ inflate
=. 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
::
++ index-timebox
|= [=lid:store =timebox:store out=_by-place]
^+ by-place
%+ roll ~(tap by timebox)
|= [[=bin:store =notification:store] out=_out]
(~(put ju out) place.bin [lid path.bin])
--

View File

@ -1,208 +0,0 @@
/- hark=hark-store, hood, docket
/+ verb, dbug, default-agent, agentio
|%
+$ card card:agent:gall
+$ state-1 [%1 lagging=_|]
::
++ lag-interval ~m10
--
%+ verb |
%- agent:dbug
^- agent:gall
=| state-1
=* state -
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
io ~(. agentio bowl)
pass pass:io
cc ~(. +> bowl)
++ on-init
^- (quip card _this)
:_ this
[onboard tire:cy check:lag ~]:cc
::
++ on-load
|= =vase
^- (quip card _this)
|^
=+ !<(old=app-states vase)
=^ cards-1 old
?. ?=(%0 -.old) `old
[[tire:cy:cc]~ old(- %1)]
?> ?=(%1 -.old)
=/ cards-tire [tire:cy:cc ~]
[(weld cards-1 cards-tire) this(state old)]
::
+$ app-states $%(state-0 state-1)
+$ state-0 [%0 lagging=_|]
--
::
++ on-save !>(state)
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ wire (on-agent:def wire sign)
[%kiln %vats ~] `this
==
::
++ on-arvo
|= [=wire sign=sign-arvo]
^- (quip card _this)
|^
?+ wire (on-arvo:def wire sign)
[%clay %tire ~] take-clay-tire
[%clay %warp * ~] (take-clay-warp i.t.t.wire)
[%check-lag ~] take-check-lag
==
::
++ take-check-lag
^- (quip card _this)
?> ?=([%behn %wake *] sign)
=+ .^(lag=? %$ (scry:io %$ /zen/lag))
?: =(lagging lag) :_(this ~[check:lag:cc])
:_ this(lagging lag)
:_ ~[check:lag:cc]
?:(lagging start:lag:cc stop:lag:cc)
::
++ take-clay-tire
^- (quip card _this)
?> ?=(%tire +<.sign)
?- -.p.sign
%& [(turn ~(tap in ~(key by p.p.sign)) warp:cy:cc) this]
%|
?- -.p.p.sign
%zest `this
%warp `this
%wait
=/ =action:hark (~(blocked de:cc desk.p.p.sign) weft.p.p.sign)
:_ this
~[(poke:ha:cc action)]
==
==
::
++ take-clay-warp
|= =desk
^- (quip card _this)
?> ?=(%writ +<.sign)
=/ cards
?. |(=(desk %base) ~(has-docket de:cc desk)) ~
=/ =action:hark ~(commit de:cc desk)
~[(poke:ha:cc action)]
[[(warp:cy:cc desk) cards] this]
--
::
++ on-fail on-fail:def
++ on-leave on-leave:def
--
|_ =bowl:gall
+* io ~(. agentio bowl)
pass pass:io
::
++ onboard
^- card
%- poke:ha
:+ %add-note [/ [q.byk.bowl /onboard]]
:: We special case this in the grid UI, but should include something
:: for third parties
[~[text+'Welcome to urbit'] ~ now.bowl / /]
::
++ lag
|%
++ check (~(wait pass /check-lag) (add now.bowl lag-interval))
++ place [q.byk.bowl /lag]
++ body `body:hark`[~[text/'Runtime lagging'] ~ now.bowl / /]
++ start (poke:ha %add-note [/ place] body)
++ stop (poke:ha %del-place place)
--
++ ha
|%
++ pass ~(. ^pass /hark)
++ poke
|=(=action:hark (poke-our:pass %hark-store hark-action+!>(action)))
--
::
++ cy
|%
++ tire ~(tire pass /clay/tire)
++ warp
|= =desk
(~(warp-our pass /clay/warp/[desk]) desk ~ %next %z da+now.bowl /)
--
::
++ de
|_ =desk
++ scry-path (scry:io desk /desk/docket-0)
++ has-docket .^(? %cu scry-path)
++ docket .^(docket:^docket %cx scry-path)
++ hash .^(@uv %cz (scry:io desk ~))
++ place `place:hark`[q.byk.bowl /desk/[desk]]
++ version ud:.^(cass:clay %cw (scry:io desk /))
++ body
|= [=path title=cord content=(unit cord)]
^- body:hark
[~[text+title] ?~(content ~ ~[text/u.content]) now.bowl ~ path]
::
::
++ title-prefix
|= =cord
%+ rap 3
?: =(desk %base)
['System software' cord ~]
?: has-docket
['App: "' title:docket '"' cord ~]
['Desk: ' desk cord ~]
::
++ get-version
?: has-docket
(rap 3 'version: ' (ver version:docket) ~)
(rap 3 'hash: ' (scot %uv hash) ~)
::
++ commit
^- action:hark
?:(=(1 version) created updated)
::
++ created
^- action:hark
:+ %add-note [/created place]
(body /desk/[desk] (title-prefix ' has been installed') ~)
::
++ updated
^- action:hark
:+ %add-note [/update place]
(body /desk/[desk] (title-prefix (rap 3 ' has been updated to ' get-version ~)) ~)
::
++ blocked
|= =weft
^- action:hark
:+ %add-note [/blocked place]
%^ body /blocked (title-prefix ' is blocked from upgrading')
`(rap 3 'Blocked waiting for system version: ' (scot %ud num.weft) 'K' ~)
::
++ ver
|= =version:^docket
=, version
`@t`(rap 3 (num major) '.' (num minor) '.' (num patch) ~)
::
++ num
|= a=@ud
`@t`(rsh 4 (scot %ui a))
--
++ note
|%
++ merge
|= [=desk hash=@uv]
^- (list body:hark)
:_ ~
:* ~[text+'Desk Updated']
~[text+(crip "Desk {(trip desk)} has been updated to hash {(scow %uv hash)}")]
now.bowl
/update/[desk]
/
==
--
--

View File

@ -1,202 +0,0 @@
/- *settings
/+ verb, dbug, default-agent, agentio
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
==
+$ state-0 [%0 settings=settings-0]
+$ state-1 [%1 settings=settings-1]
+$ state-2 [%2 =settings]
--
=| state-2
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
do ~(. +> bol)
def ~(. (default-agent this %|) bol)
io ~(. agentio bol)
::
++ on-init on-init:def
::
++ on-save !>(state)
::
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
|-
?- -.old
%0 $(old [%1 +.old])
%1 $(old [%2 (~(put by *^settings) %landscape settings.old)])
%2 `this(state old)
==
::
++ on-poke
|= [mar=mark vas=vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
?. ?=(%settings-event mar)
(on-poke:def mar vas)
=/ evt=event !<(event vas)
=^ cards state
?- -.evt
%put-bucket (put-bucket:do [desk key bucket]:evt)
%del-bucket (del-bucket:do [desk key]:evt)
%put-entry (put-entry:do [desk buc key val]:evt)
%del-entry (del-entry:do [desk buc key]:evt)
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
?> (team:title our.bol src.bol)
?+ pax (on-watch:def pax)
[%all ~]
[~ this]
::
[%desk @ ~]
=* desk i.t.pax
[~ this]
::
[%bucket @ @ ~]
=* desk i.t.pax
=* bucket-key i.t.t.pax
?> (~(has bi settings) desk bucket-key)
[~ this]
::
[%entry @ @ @ ~]
=* desk i.t.pax
=* bucket-key i.t.t.pax
=* entry-key i.t.t.t.pax
=/ bucket (~(got bi settings) desk bucket-key)
?> (~(has by bucket) entry-key)
[~ this]
==
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(`data`all+settings)
::
[%x %desk @ ~]
=* desk i.t.t.pax
=/ desk-settings (~(gut by settings) desk ~)
``settings-data+!>(desk+desk-settings)
::
[%x %bucket @ @ ~]
=* desk i.t.t.pax
=* buc i.t.t.t.pax
=/ bucket=(unit bucket) (~(get bi settings) desk buc)
?~ bucket [~ ~]
``settings-data+!>(`data`bucket+u.bucket)
::
[%x %entry @ @ @ ~]
=* desk i.t.t.pax
=* buc i.t.t.t.pax
=* key i.t.t.t.t.pax
=/ =bucket (~(gut bi settings) desk buc *bucket)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(`data`entry+u.entry)
::
[%x %has-bucket @ @ ~]
=/ desk i.t.t.pax
=/ buc i.t.t.t.pax
=/ has-bucket=? (~(has bi settings) desk buc)
``noun+!>(`?`has-bucket)
::
[%x %has-entry @ @ @ ~]
=* desk i.t.t.pax
=* buc i.t.t.t.pax
=* key i.t.t.t.t.pax
=/ =bucket (~(gut bi settings) desk buc *bucket)
=/ has-entry=? (~(has by bucket) key)
``noun+!>(`?`has-entry)
==
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
:: +put-bucket: put a bucket in the top level settings map, overwriting if it
:: already exists
::
++ put-bucket
|= [=desk =key =bucket]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/desk/[desk]
/bucket/[desk]/[key]
==
:- [(give-event pas %put-bucket desk key bucket)]~
state(settings (~(put bi settings) desk key bucket))
::
:: +del-bucket: delete a bucket from the top level settings map
::
++ del-bucket
|= [=desk =key]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/desk/[desk]
/bucket/[key]
==
:- [(give-event pas %del-bucket desk key)]~
state(settings (~(del bi settings) desk key))
::
:: +put-entry: put an entry in a bucket, overwriting if it already exists
:: if bucket does not yet exist, create it
::
++ put-entry
|= [=desk buc=key =key =val]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/desk/[desk]
/bucket/[desk]/[buc]
/entry/[desk]/[buc]/[key]
==
=/ =bucket (~(put by (~(gut bi settings) desk buc *bucket)) key val)
:- [(give-event pas %put-entry desk buc key val)]~
state(settings (~(put bi settings) desk buc bucket))
::
:: +del-entry: delete an entry from a bucket, fail quietly if bucket does not
:: exist
::
++ del-entry
|= [=desk buc=key =key]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/desk/[desk]
/bucket/[desk]/[buc]
/entry/[desk]/[buc]/[key]
==
=/ bucket=(unit bucket) (~(get bi settings) desk buc)
?~ bucket
[~ state]
=. u.bucket (~(del by u.bucket) key)
:- [(give-event pas %del-entry desk buc key)]~
state(settings (~(put bi settings) desk buc u.bucket))
::
++ give-event
|= [pas=(list path) evt=event]
^- card
[%give %fact pas %settings-event !>(evt)]
--

View File

@ -1,10 +1,7 @@
:~ %docket
%treaty
%hark-store
%hark-system-hook
%settings
%settings-store
%storage
%settings
%reel
%bait
==

View File

@ -1,254 +0,0 @@
/- sur=hark-store
^?
=, sur
=< [. sur]
|%
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
^- json
%+ 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)
%saw-place (saw-place +.upd)
%all-stats (all-stats +.upd)
%del-place (place +.upd)
::%read-note (index +.upd)
::%note-read (note-read +.upd)
%archived (archived +.upd)
==
::
++ 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))
==
::
++ archived
|= [t=^time l=^lid n=^notification]
%- pairs
:~ lid+(lid l)
time+s+(scot %ud t)
notification+(notification n)
==
::
++ note-read
|= *
(pairs ~)
::
++ all-stats
|= places=(map ^place ^stats)
^- json
:- %a
^- (list json)
%+ turn ~(tap by places)
|= [p=^place s=^stats]
%- pairs
:~ stats+(stats s)
place+(place p)
==
::
++ stats
|= s=^stats
^- json
%- pairs
:~ each+a+(turn ~(tap in each.s) (cork spat (lead %s)))
last+(time last.s)
count+(numb count.s)
==
++ more
|= upds=(list ^update)
^- json
a+(turn upds update)
::
++ place
|= =^place
%- pairs
:~ desk+s+desk.place
path+s+(spat path.place)
==
::
++ bin
|= =^bin
%- pairs
:~ place+(place place.bin)
path+s+(spat path.bin)
==
++ notification
|= ^notification
^- json
%- pairs
:~ time+(time date)
bin+(^bin bin)
body+(bodies body)
==
++ bodies
|= bs=(list ^body)
^- json
a+(turn bs body)
::
++ contents
|= cs=(list ^content)
^- json
a+(turn cs content)
::
++ content
|= c=^content
^- json
%+ frond -.c
?- -.c
%ship s+(scot %p ship.c)
%text s+cord.c
==
::
++ body
|= ^body
^- json
%- pairs
:~ title+(contents title)
content+(contents content)
time+(^time time)
link+s+(spat link)
==
::
++ binned-notification
|= [=^bin =^notification]
%- pairs
:~ bin+(^bin bin)
notification+(^notification notification)
==
++ lid
|= l=^lid
^- json
%+ frond -.l
?- -.l
?(%seen %unseen) ~
%archive s+(scot %ud time.l)
==
::
++ timebox
|= [li=^lid l=(list ^notification)]
^- json
%- pairs
:~ lid+(lid li)
notifications+a+(turn l notification)
==
::
++ read-each
|= [p=^place pax=^path]
%- pairs
:~ place+(place p)
path+(path pax)
==
::
++ unread-count
|= [p=^place inc=? count=@ud]
%- pairs
:~ place+(place p)
inc+b+inc
count+(numb count)
==
--
++ dejs
=, dejs:format
|%
++ ship (su ;~(pfix sig fed:ag))
:: TODO: fix +stab
::
++ pa
|= j=json
^- path
?> ?=(%s -.j)
?: =('/' p.j) /
(stab p.j)
::
++ place
%- ot
:~ desk+so
path+pa
==
::
++ bin
%- ot
:~ path+pa
place+place
==
::
++ read-each
%- ot
:~ place+place
path+pa
==
::
:: parse date as @ud
:: TODO: move to zuse
++ sd
|= jon=json
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
::
++ lid
%- of
:~ archive+sd
unseen+ul
seen+ul
==
::
++ archive
%- ot
:~ lid+lid
bin+bin
==
++ content
%- of
:~ text+so
ship+ship
==
::
++ body
%- ot
:~ title+(ar content)
content+(ar content)
time+di
binned+pa
link+pa
==
::
++ add-note
%- ot
:~ bin+bin
body+body
==
::
++ action
^- $-(json ^action)
%- of
:~ archive-all+ul
archive+archive
opened+ul
read-count+place
read-each+read-each
read-note+bin
add-note+add-note
==
--
--

View File

@ -1,35 +0,0 @@
/+ store=hark-store
|_ =archive:store
++ orm ((on @da timebox:store) gth)
++ del
|= [=time =bin:store]
?~ 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 archive time) ~)
=. box (~(put by box) bin notification)
(put:orm archive time box)
::
++ get
|= [=time =bin:store]
^- (unit notification:store)
?~ box=(get:orm archive time) ~
(~(get by u.box) bin)
::
++ got
|= [=time =bin:store]
(need (get time bin))
::
++ has
|= [=time =bin:store]
?~((get time bin) %.n %.y)
::
++ jab
|= [=time =bin:store f=$-(notification:store notification:store)]
(put time bin (f (got time bin)))
::
++ job
|= [=time =bin:store f=$-((unit notification:store) notification:store)]
(put time bin (f (get time bin)))
--

View File

@ -1,159 +0,0 @@
^?
::
:: %hark-store: Notification, unreads store
::
:: Timeboxing & binning:
::
:: Unread notifications accumulate in $unreads. They are grouped by
:: their $bin. A notification may become read by either:
:: a) being read by a %read-count or %read-each or %read-note
:: b) being read by a %seen
::
:: If a) then we insert the corresponding bin into $reads at the
:: current timestamp
:: If b) then we empty $unreads and move all bins to $reads at the
:: current timestamp
::
:: Unread tracking:
:: Unread tracking has two 'modes' which may be used concurrently,
:: if necessary.
::
:: count:
:: This stores the unreads as a simple atom, describing the number
:: of unread items. May be increased with %unread-count and
:: set to zero with %read-count. Ideal for high-frequency linear
:: datastructures, e.g. chat
:: each:
:: This stores the unreads as a set of paths, describing the set of
:: unread items. Unreads may be added to the set with %unread-each
:: and removed with %read-each. Ideal for non-linear, low-frequency
:: datastructures, e.g. blogs
::
|%
:: $place: A location, under which landscape stores stats
::
:: .desk must match q.byk.bowl
:: Examples:
:: A chat:
:: [%landscape /~dopzod/urbit-help]
:: A note in a notebook:
:: [%landscape /~darrux-landes/feature-requests/12374893234232]
:: A group:
:: [%hark-group-hook /~bitbet-bolbel/urbit-community]
:: Comments on a link
:: [%landscape /~dabben-larbet/urbit-in-the-news/17014118450499614194868/2]
::
+$ place [=desk =path]
::
:: $bin: Identifier for grouping notifications
::
:: Examples
:: A mention in a chat:
:: [/mention %landscape /~dopzod/urbit-help]
:: New messages in a chat
:: [/message %landscape /~dopzod/urbit-help]
:: A new comment in a notebook:
:: [/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]
[%text =cord]
==
::
:: $body: A notification body
::
+$ body
$: title=(list content)
content=(list content)
=time
binned=path
link=path
==
::
+$ notification
[date=@da =bin body=(list body)]
:: $timebox: Group of notificatons
+$ timebox
(map bin notification)
:: $archive: Archived notifications, ordered by time
+$ archive
((mop @da timebox) gth)
::
+$ action
$% :: hook actions
::
:: %add-note: add a notification
[%add-note =bin =body]
::
:: %del-place: Underlying resource disappeared, remove all
:: associated notifications
[%del-place =place]
:: %unread-count: Change unread count by .count
[%unread-count =place inc=? count=@ud]
:: %unread-each: Add .path to list of unreads for .place
[%unread-each =place =path]
:: %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 =lid =bin]
:: %read-count: set unread count to zero
[%read-count =place]
:: %read-each: remove path from unreads for .place
[%read-each =place =path]
:: %read-note: Read note at .bin
[%read-note =bin]
:: %archive-all: Archive all notifications
[%archive-all ~]
:: %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
::
+$ stats
$: count=@ud
each=(set path)
last=@da
timebox=(unit @da)
==
::
+$ 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.
::
[%timebox =lid =(list notification)]
:: %place-stats: description of .stats for a .place
[%place-stats =place =stats]
:: %place-stats: stats for all .places
[%all-stats places=(map place stats)]
==
--