hark-store: add tests, fix memory leak

pkg/garden/app/hark-store.hoon

@@ -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)
-  (~(get by timebox) bin)
+  =;  =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])
 --

pkg/garden/tests/app/hark-store.hoon

@@ -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))
+--