mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 08:32:39 +03:00
hark-store: add tests, fix memory leak
This commit is contained in:
Liam Fitzgerald
parent
52d0c33d59
commit
678cf651ad
@ -91,31 +91,14 @@
|
||||
=/ old
|
||||
!<(versioned-state old-vase)
|
||||
=| cards=(list card)
|
||||
|^ ^- (quip card _this)
|
||||
^- (quip card _this)
|
||||
?: ?=(%8 -.old)
|
||||
=. -.state old
|
||||
=. +.state inflate
|
||||
=. +.state inflate:ha
|
||||
:_(this (flop cards))
|
||||
::
|
||||
:_ this
|
||||
(poke-our:pass %hark-graph-hook hark-graph-migrate+old-vase)^~
|
||||
::
|
||||
++ 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])
|
||||
::
|
||||
++ inflate
|
||||
=. 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
|
||||
--
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
@ -178,6 +161,10 @@
|
||||
?+ val ~|(%bad-noun-poke !!)
|
||||
%print ~&(+.state [~ state])
|
||||
%clear [~ state(. *inflated-state)]
|
||||
%sane
|
||||
~& +.state
|
||||
~& inflate
|
||||
?>(=(+.state inflate) `state)
|
||||
==
|
||||
::
|
||||
++ poke-us
|
||||
@ -412,10 +399,11 @@
|
||||
=/ =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])
|
||||
=/ existing (get-lid archive/time bin)
|
||||
=/ new (merge-notification existing note)
|
||||
=. poke-core
|
||||
(put-lid archive/time bin new)
|
||||
=. poke-core (del-lid lid 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)
|
||||
@ -483,8 +471,13 @@
|
||||
::
|
||||
++ get-lid
|
||||
|= [=lid:store =bin:store]
|
||||
=/ =timebox:store ?:(?=(%unseen -.lid) unseen seen)
|
||||
=; =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]
|
||||
@ -522,4 +515,21 @@
|
||||
^- (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])
|
||||
--
|
||||
|
||||
90
pkg/garden/tests/app/hark-store.hoon
Normal file
90
pkg/garden/tests/app/hark-store.hoon
Normal file
@ -0,0 +1,90 @@
|
||||
/- hark=hark-store
|
||||
/+ *test, re=hark-unreads
|
||||
/= agent /app/hark-store
|
||||
|%
|
||||
++ place
|
||||
^- place:hark
|
||||
[%landscape /graph/~zod/test]
|
||||
::
|
||||
++ bin
|
||||
^- bin:hark
|
||||
[/ place]
|
||||
|
||||
::
|
||||
++ body
|
||||
|= run=@
|
||||
:* ~[text/'Title']
|
||||
~[text/(crip "Contents {(scow %ud run)}")]
|
||||
`time`(add (mul ~s1 run) *time)
|
||||
/
|
||||
/test
|
||||
==
|
||||
::
|
||||
++ add-note
|
||||
|= run=@
|
||||
^- action:hark
|
||||
[%add-note bin (body run)]
|
||||
::
|
||||
++ read-count
|
||||
^- action:hark
|
||||
[%read-count place]
|
||||
::
|
||||
+$ state
|
||||
$: %8
|
||||
places=(map place:hark stats:hark)
|
||||
seen=timebox:hark
|
||||
unseen=timebox:hark
|
||||
=archive:hark
|
||||
half-open=(map bin:hark @da)
|
||||
==
|
||||
++ bowl
|
||||
|= run=@ud
|
||||
^- bowl:gall
|
||||
:* [~zod ~zod %hark-store]
|
||||
[~ ~]
|
||||
[run `@uvJ`(shax run) (add (mul run ~s1) *time) [~zod %garden ud+run]]
|
||||
==
|
||||
--
|
||||
|%
|
||||
::
|
||||
++ test-half-open
|
||||
=| run=@ud
|
||||
=^ mov1 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>((add-note run)))
|
||||
=^ mova agent
|
||||
(~(on-poke agent (bowl run)) %noun !>(%sane))
|
||||
=. run +(run)
|
||||
=^ mov2 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>(read-count))
|
||||
=^ mov3 agent
|
||||
(~(on-poke agent (bowl run)) %noun !>(%sane))
|
||||
=/ expected-archive=notification:hark
|
||||
[(add *time (mul ~s1 0)) bin ~[(body 0)]]
|
||||
=+ !<(=state on-save:agent)
|
||||
=/ actual-archive=notification:hark
|
||||
(~(got re archive.state) (add *time ~s1) bin)
|
||||
(expect-eq !>(expected-archive) !>(actual-archive))
|
||||
::
|
||||
++ test-half-open-double
|
||||
=| run=@ud
|
||||
=^ mov1 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>((add-note run)))
|
||||
=. run +(run)
|
||||
=^ mov2 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>(read-count))
|
||||
=. run +(run)
|
||||
=^ mov3 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>((add-note run)))
|
||||
=. run +(run)
|
||||
=^ mov4 agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>(read-count))
|
||||
=. run +(run)
|
||||
=^ mov5 agent
|
||||
(~(on-poke agent (bowl run)) %noun !>(%sane))
|
||||
=/ expected-archive=notification:hark
|
||||
[(add *time (mul ~s1 2)) bin ~[(body 2) (body 0)]]
|
||||
=+ !<(=state on-save:agent)
|
||||
=/ actual-archive=notification:hark
|
||||
(~(got re archive.state) (add *time ~s1) bin)
|
||||
(expect-eq !>(expected-archive) !>(actual-archive))
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user