From ff5fabfcff541ffb57981fff5fcc1bb83f3bca5b Mon Sep 17 00:00:00 2001
From: Hunter Miller <hunter@hmiller.dev>
Date: Wed, 12 Apr 2023 15:57:44 -0500
Subject: [PATCH] hark: pulling from new groups

---
 desk/app/hark.hoon          | 407 ++++++++++++++++++++++++++++++++++++
 desk/gen/hark/add-note.hoon |  14 ++
 desk/gen/hark/saw-rope.hoon |   8 +
 desk/gen/hark/saw-seam.hoon |   8 +
 desk/lib/hark-json.hoon     | 185 ++++++++++++++++
 desk/mar/hark/action.hoon   |  12 +-
 desk/mar/hark/blanket.hoon  |  14 ++
 desk/mar/hark/carpet.hoon   |  14 ++
 desk/mar/hark/skeins.hoon   |  14 ++
 desk/mar/hark/update.hoon   |  13 --
 desk/mar/hark/yarn.hoon     |  14 ++
 desk/sur/hark.hoon          | 112 ++++++++++
 12 files changed, 797 insertions(+), 18 deletions(-)
 create mode 100644 desk/app/hark.hoon
 create mode 100644 desk/gen/hark/add-note.hoon
 create mode 100644 desk/gen/hark/saw-rope.hoon
 create mode 100644 desk/gen/hark/saw-seam.hoon
 create mode 100644 desk/lib/hark-json.hoon
 create mode 100644 desk/mar/hark/blanket.hoon
 create mode 100644 desk/mar/hark/carpet.hoon
 create mode 100644 desk/mar/hark/skeins.hoon
 delete mode 100644 desk/mar/hark/update.hoon
 create mode 100644 desk/mar/hark/yarn.hoon
 create mode 100644 desk/sur/hark.hoon

diff --git a/desk/app/hark.hoon b/desk/app/hark.hoon
new file mode 100644
index 0000000..21fc0c8
--- /dev/null
+++ b/desk/app/hark.hoon
@@ -0,0 +1,407 @@
+/-  h=hark
+/+  default-agent, verb, dbug
+/+  hark-json  :: performance
+/+  mp=mop-extensions
+|%
++$  card  card:agent:gall
+++  mope  ((mp @ud thread:h) lte)
+++  yarns-per-update  3
+++  rug-trim-size  10
+++  blanket-size  10   :: page size for blankets
+++  gc-interval  ~h24
+::  TODO: move to stdlib
+++  zip
+  |*  [a=(list) b=(list)]
+  ^-  (list _?>(?=(^ a) ?>(?=(^ b) [i.a i.b])))
+  ?~  a  ~
+  ?~  b  ~
+  :-  [i.a i.b] 
+  $(a t.a, b t.b)
+::
+++  quilt-idx
+  |=  =quilt:h
+  ?~  tal=(ram:on:quilt:h quilt)
+    0
+  +(key.u.tal)
+::
++$  state-0
+  $:  %0
+      yarns=(map id:h yarn:h)
+      groups=(map flag:h rug:h)
+      desks=(map desk rug:h)
+      all=rug:h
+      next-gc=@da
+  ==
+--
+%-  agent:dbug
+%+  verb  |
+=|  state-0
+=*  state  -
+=<
+  |_  =bowl:gall
+  +*  this  .
+      cor    ~(. +> [bowl ~])
+      def   ~(. (default-agent this %|) bowl)
+  ++  on-init  
+    =^  cards  state
+      abet:set-gc-wake:cor
+    [cards this]
+  ++  on-save  !>(state)
+  ++  on-load
+    |=  =vase
+    =/  old=(unit state-0)
+      (mole |.(!<(state-0 vase)))  
+    ?~  old  on-init
+    `this(state u.old)
+  ++  on-poke
+    |=  [=mark =vase]
+    =^  cards  state
+      abet:(poke:cor mark vase)
+    [cards this]
+  ++  on-watch
+    |=  =path
+    =^  cards  state
+      abet:(watch:cor path)
+    [cards this]
+  ++  on-peek  peek:cor
+  ++  on-arvo
+    |=  [=wire sign=sign-arvo]
+    =^  cards  state
+      abet:(arvo:cor wire sign)
+    [cards this]
+  ++  on-agent
+    |=  [=wire =sign:agent:gall]
+    =^  cards  state
+      abet:(agent:cor wire sign)
+    [cards this]
+  ++  on-leave  on-leave:def
+  ++  on-fail   on-fail:def
+  --
+|_  [=bowl:gall cards=(list card)]
+++  abet  [(flop cards) state]
+++  cor   .
+++  emit  |=(=card cor(cards [card cards]))
+++  poke
+  |=  [=mark =vase]
+  ^+  cor
+  ?+    mark  ~|(bad-mark/mark !!)
+      %hark-action
+    =+  !<(act=action:h vase)
+    =.  cor  (give-ui act)
+    ?-    -.act
+      %saw-rope  (saw-rope rope.act)
+      %saw-seam  (saw-seam +.act)
+      %add-yarn  (add-yarn +.act)
+    ==
+  ==
+++  peek
+  |=  =(pole knot)
+  ^-  (unit (unit cage))
+  ?+    pole  [~ ~]
+  ::
+      [%x %all rest=*]  (scry-rug rest.pole all/~ all)
+  ::
+      [%x %group ship=@ name=@ rest=*]
+    =/  =ship  (slav %p ship.pole)
+    =/  =flag:h  [ship name.pole]
+    =/  =rug:h  (~(got by groups) flag)
+    (scry-rug rest.pole group/flag rug)
+  ::
+      [%x %desk desk=@ rest=*]
+    (scry-rug rest.pole desk/desk.pole (~(got by desks) desk.pole))
+  ::
+      [%x %yarn uid=@ ~]
+    ``hark-yarn+!>((~(got by yarns) (slav %uv uid.pole)))
+  ==
+::
+++  is-us  =(our src):bowl
+::
+++  watch
+  |=  =path
+  ^+  cor
+  ?+  path  ~|(evil-watch/path !!)
+    [%ui ~]  ?>(is-us cor)
+  ==
+::
+++  arvo
+  |=  [=wire sign=sign-arvo]
+  ^+  cor
+  ?+    wire  ~|(bad-arvo-take/wire !!)
+      [%gc ~]
+    =.  cor  stale
+    set-gc-wake
+  ==
+++  agent
+  |=  [=wire =sign:agent:gall]
+  ^+  cor
+  cor
+::
+++  scry-rug
+  |=  [=(pole knot) =seam:h =rug:h] 
+  ^-  (unit (unit cage))
+  ?+    pole  [~ ~]
+      [%skeins ~]  ``hark-skeins+!>((rug-to-skeins seam rug))
+      [%latest ~]  ``hark-carpet+!>((rug-to-carpet seam rug))
+  ::
+      [%quilt idx=@ ~]
+    =/  idx  (slav %ud idx.pole)
+    ``hark-blanket+!>((rug-to-blanket seam idx rug))
+  ==
+++  rug-to-skeins
+  |=  [=seam:h =rug:h]
+  ^-  (list skein:h)
+  %+  welp
+    %+  turn
+      ~(tap by new.rug)
+    |=  [* =thread:h]
+    (thread-to-skein thread &)
+  %+  turn
+    (top:mope qul.rug blanket-size)
+  |=  [* =thread:h]
+  (thread-to-skein thread |)
+::
+++  thread-to-skein
+  |=  [=thread:h unread=?]
+  =/  yrns=(list yarn:h)
+    %+  sort
+      (turn (thread-to-yarns thread) tail)
+    |=  [a=yarn:h b=yarn:h]
+    (gth tim.a tim.b)
+  =/  top=yarn:h  (head yrns)
+  ^-  skein:h
+  :*  tim.top
+      (lent yrns)
+      (ship-count yrns)
+      top
+      unread
+  ==
+::
+++  ship-count
+  |=  yrns=(list yarn:h)
+  ^-  @ud
+  %~  wyt  in
+  %+  roll
+    yrns
+  |=  [=yarn:h ships=(set ship)]
+  %-  ~(gas in ships)
+  ^-  (list ship)
+  %+  murn
+    con.yarn
+  |=  =content:h
+  ^-  (unit ship)
+  ?@  content  ~
+  ?+  -.content  ~
+    %ship  (some p.content)
+  ==
+::
+++  rug-to-carpet
+  |=  [=seam:h =rug:h]
+  ^-  carpet:h
+  =-  [seam - new.rug (quilt-idx qul.rug)]
+  %-  ~(gas by *(map id:h yarn:h))
+  %-  zing
+  %+  turn  ~(tap by new.rug)
+  |=  [=rope:h =thread:h]
+  ^-  (list [id:h yarn:h])
+  (thread-to-yarns thread)
+  ::
+++  thread-to-yarns
+  |=  =thread:h
+  ^-  (list [id:h yarn:h])
+  %+  murn   ~(tap in thread)
+  |=  =id:h
+  ^-  (unit [id:h yarn:h])
+  ?~  yar=(~(get by yarns) id)
+    ~
+  `[id u.yar]
+::
+++  index-quilt
+  |=  [=quilt:h idx=@ud]
+  (gas:on:quilt:h *quilt:h (bat:mope quilt `idx blanket-size))
+::
+++  rug-to-blanket
+  |=  [=seam:h idx=@ud =rug:h]
+  ^-  blanket:h
+  =/  indexed
+    (index-quilt qul.rug idx)
+  =/  yarns=(map id:h yarn:h)
+    %-  ~(gas by *(map id:h yarn:h))
+    %-  zing
+    %+  turn  (tap:on:quilt:h indexed)
+    |=  [num=@ud =thread:h]
+    (thread-to-yarns thread)
+  [seam yarns indexed]
+::
+++  set-gc-wake
+  =.  next-gc  (add now.bowl gc-interval)
+  (emit %pass /gc %arvo %b %wait next-gc)
+::
+++  give-ui
+  |=  =action:h
+  ^+  cor
+  (emit %give %fact ~[/ui] hark-action+!>(action))
+::
+++  threads-to-update
+  |=  [=seam:h teds=(map @ thread:h)]
+  ^-  *
+  =-  [- seam teds]
+  ^-  (map id:h yarn:h)
+  %-  ~(gas by *(map id:h yarn:h))
+  %-  zing
+  %+  turn  ~(tap by teds)
+  |=  [=time =thread:h]
+  %+  scag  yarns-per-update
+  %+  murn  ~(tap in thread)
+  |=  =id:h
+  ^-  (unit [id:h yarn:h])
+  ?~  yar=(~(get by yarns) id)  ~
+  `[id u.yar]
+::  TODO: namespacing conflicts?
+++  saw-thread
+  |=  =rope:h
+  |=  =rug:h
+  ?~  ted=(~(get by new.rug) rope)  rug
+  =.  new.rug    (~(del by new.rug) rope)
+  =/  start  (quilt-idx qul.rug)
+  =.  qul.rug  (put:on:quilt:h qul.rug start u.ted)
+  rug
+::
+++  saw-rope
+  |=  =rope:h
+  =/  saw  (saw-thread rope)
+  =.  all  (saw all)
+  =.  desks
+    (~(jab by desks) des.rope saw)
+  =?  groups  ?=(^ gop.rope)
+    (~(jab by groups) u.gop.rope saw)
+  cor
+++  rug-to-yarns
+  |=  =rug:h
+  ^-  (map id:h yarn:h)
+  %-  ~(gas by *(map id:h yarn:h))
+  ~
+    ::^-  (list [id:h yarn:h])
+    :: %-  zing
+    :: %+  turn  ~(tap by new.rug)
+    :: |=  [=rope:h =thread:h]
+
+::  +stale: garbage collection
+::
+++  stale
+  |^ 
+  =/  ids  ~(key by yarns)
+  =.  ids  (~(dif in ids) (ids-for-rug all))
+  =.  ids  (~(dif in ids) ids-for-groups)
+  =.  ids  (~(dif in ids) ids-for-desks)
+  =/  ids  ~(tap in ids)
+  |-
+  ?~  ids  cor
+  $(yarns (~(del by yarns) i.ids), ids t.ids)
+  ++  trim-rug
+    |=  =rug:h
+    =*  on  on:quilt:h
+    ^+  rug
+    ?~  hed=(pry:on qul.rug)
+      rug
+    ::  TODO: bad asymptotics
+    =+  siz=(lent (tap:on qul.rug))
+    ?:  (lte siz 50)  
+      rug  :: bail if not much there
+    =/  dip  (dip:on ,count=@ud)
+    =.  qul.rug
+      =<  +
+      %^  dip  qul.rug  0
+      |=  [count=@ud key=@ud =thread:h]
+      ^-  [(unit thread:h) stop=? count=@ud]
+      =-  [~ - +(count)]
+      (gte count rug-trim-size) 
+    rug
+  ::
+  ++  ids-for-rug
+    |=  =rug:h
+    %-  ~(gas in *(set id:h))
+    ^-  (list id:h)
+    %+  welp
+      ^-  (list id:h)
+      %-  zing
+      %+  turn  ~(val by new.rug)
+      |=  =thread:h
+      ~(tap in thread)
+    ^-  (list id:h)
+    %-  zing
+    %+  turn  (tap:on:quilt:h qul.rug)
+    |=  [idx=@ud =thread:h]
+    ~(tap in thread)
+  ::
+  ++  ids-for-desks
+    =/  des   ~(tap in ~(key by desks))
+    =|  ids=(set id:h)
+    |-  ^+  ids
+    ?~  des  ids
+    =/  =rug:h  (~(got by desks) i.des)
+    $(ids (~(uni in ids) (ids-for-rug rug)), des t.des)
+  ::
+  ++  ids-for-groups
+    =/  gop  ~(tap in ~(key by groups))
+    =|  ids=(set id:h)
+    |-  ^+  ids
+    ?~  gop  ids
+    =/  =rug:h  (~(got by groups) i.gop)
+    $(ids (~(uni in ids) (ids-for-rug rug)), gop t.gop)
+  --
+++  saw-seam
+  |=  =seam:h
+  =/  fun  
+    |=  =rug:h
+    =/  start  (quilt-idx qul.rug)
+    =/  new  ~(val by new.rug)
+    %_  rug
+        new  ~
+    ::
+        qul  
+      %+  gas:on:quilt:h  qul.rug
+      (zip (gulf start (add start (lent new))) new)
+    ==
+  =.  .
+    ?-  -.seam
+      %group  .(groups (~(jab by groups) flag.seam fun))
+      %desk    .(desks (~(jab by desks) desk.seam fun))
+      %all     .(all (fun all))
+    ==
+  cor
+::
+++  add-yarn
+  =|  [add-all=? add-desk=? =yarn:h]
+  |%
+  ++  $
+    =.  yarns  (~(put by yarns) id.yarn yarn)
+    =.  cor  weave-all
+    =.  cor  weave-group
+    weave-desk
+  ::
+  ++  weave-all
+    ?.  add-all  cor
+    cor(all (weave-rug all all/~))
+  ++  weave-rug
+    |=  [=rug:h =seam:h]
+    =/  =thread:h   (~(gut by new.rug) rop.yarn ~)
+    =.  thread   (~(put in thread) id.yarn)
+    =.  new.rug   (~(put by new.rug) rop.yarn thread)
+    rug
+  ::
+  ++  weave-group
+    ?~  gop.rop.yarn  cor
+    =*  group  u.gop.rop.yarn
+    =/  =rug:h  (~(gut by groups) group *rug:h) 
+    =.  rug  (weave-rug rug group/group)
+    =.  groups  (~(put by groups) group rug)
+    cor
+  ::
+  ++  weave-desk
+    ?.  add-desk  cor
+    =/  =rug:h  (~(gut by desks) des.rop.yarn *rug:h) 
+    =.  rug     (weave-rug rug desk/des.rop.yarn)
+    =.  desks   (~(put by desks) des.rop.yarn rug)
+    cor
+  --
+--
diff --git a/desk/gen/hark/add-note.hoon b/desk/gen/hark/add-note.hoon
new file mode 100644
index 0000000..ab76c44
--- /dev/null
+++ b/desk/gen/hark/add-note.hoon
@@ -0,0 +1,14 @@
+/-  h=hark
+:-  %say
+|=  $:  [now=@da eny=@uvJ =beak]
+        [[all=? des=? =desk con=(list content:h)] [group=(unit flag:h) thread=path ~]]
+    ==
+=/  =id:h  (end [7 1] eny)
+=/  =rope:h
+  [group ~ desk thread] 
+=/  =note:h
+  [id rope now con ~ ~]
+~&  >  adding/id
+:-  %hark-action
+^-  action:h
+[%add-note all des note]
diff --git a/desk/gen/hark/saw-rope.hoon b/desk/gen/hark/saw-rope.hoon
new file mode 100644
index 0000000..4dab8d4
--- /dev/null
+++ b/desk/gen/hark/saw-rope.hoon
@@ -0,0 +1,8 @@
+/-  h=hark
+:-  %say
+|=  $:  [now=@da eny=@uvJ =beak]
+        [[=rope:h ~] ~]
+    ==
+:-  %hark-action
+^-  action:h
+[%saw-rope rope]
diff --git a/desk/gen/hark/saw-seam.hoon b/desk/gen/hark/saw-seam.hoon
new file mode 100644
index 0000000..3380d23
--- /dev/null
+++ b/desk/gen/hark/saw-seam.hoon
@@ -0,0 +1,8 @@
+/-  h=hark
+:-  %say
+|=  $:  [now=@da eny=@uvJ =beak]
+        [[=seam:h ~] ~]
+    ==
+:-  %hark-action
+^-  action:h
+[%saw-seam seam]
diff --git a/desk/lib/hark-json.hoon b/desk/lib/hark-json.hoon
new file mode 100644
index 0000000..d357bd0
--- /dev/null
+++ b/desk/lib/hark-json.hoon
@@ -0,0 +1,185 @@
+/-  h=hark
+|%
+++  enjs
+  =,  enjs:format
+  |%
+  ++  action
+    |=  a=action:h
+    %+  frond  -.a
+    ?-  -.a
+      %add-yarn  (add-yarn +.a)
+      %saw-seam  (seam +.a)
+      %saw-rope  (rope +.a)
+    ==
+  ::
+  ++  blanket
+    |=  b=blanket:h
+    %-  pairs
+    :~  seam/(seam seam.b)
+        yarns/(yarns yarns.b)
+        quilt/(quilt quilt.b)
+    ==
+  ::
+  ++  quilt
+    |=  q=quilt:h
+    %-  pairs
+    %+  turn  (tap:on:quilt:h q)
+    |=  [num=@ud t=thread:h]
+    [(scot %ud num) (thread t)]
+  ::
+  ++  add-yarn
+    |=  [all=? desk=? yar=yarn:h]
+    %-  pairs
+    :~  all/b/all
+        desk/b/desk
+        yarn/(yarn yar)
+    ==
+  ::
+  ++  carpet
+    |=  c=carpet:h
+    ^-  json
+    %-  pairs
+    :~  seam/(seam seam.c)
+        yarns/(yarns yarns.c)
+        cable/(cable cable.c)
+        stitch/(numb stitch.c)
+    ==
+  ::
+  ++  cable
+    |=  c=(map rope:h thread:h)
+    ^-  json
+    :-  %a
+    %+  turn  ~(tap by c)
+    |=  [r=rope:h t=thread:h]
+    %-  pairs
+    :~  rope/(rope r)
+        thread/(thread t)
+    ==
+  ::
+  ++  skeins
+    |=  sks=(list skein:h)
+    ^-  json
+    :-  %a
+    %+  turn  sks
+    |=  =skein:h
+    %-  pairs
+    :~  time/(time time.skein)
+        count/(numb count.skein)
+        ship-count/(numb ship-count.skein)
+        top/(yarn top.skein)
+        unread/b/unread.skein
+    ==
+  ++  id
+    |=  i=id:h
+    ^-  json
+    s/(scot %uv i)
+  ::
+  ++  thread
+    |=  t=thread:h
+    ^-  json
+    :-  %a
+    (turn ~(tap in t) id)
+  ::
+  ++  threads
+    |=  ts=(map @da thread:h)
+    %-  pairs
+    %+  turn  ~(tap by ts)
+    |=  [tim=@da t=thread:h]
+    ^-  [cord json]
+    [(scot %da tim) (thread t)]
+  ::
+  ++  update
+    |=  u=update:h
+    %-  pairs
+    :~  yarns/(yarns yarns.u)
+        seam/(seam seam.u)
+        threads/(threads threads.u)
+    ==
+  ::
+  ++  yarns
+    |=  ys=(map id:h yarn:h)
+    ^-  json
+    %-  pairs
+    %+  turn  ~(tap by ys)
+    |=  [i=id:h y=yarn:h]
+    [(scot %uv i) (yarn y)]
+  ::
+  ++  yarn
+    |=  y=yarn:h
+    ^-  json
+    %-  pairs
+    :~  id/s/(scot %uv id.y)
+        rope/(rope rop.y)
+        time/(time tim.y)
+        con/a/(turn con.y content)
+        wer/s/(spat wer.y)
+        button/~
+    ==
+  ::
+  ++  content
+    |=  c=content:h
+    ^-  json
+    ?@  c  s/c
+    ?-  -.c
+      %ship  (frond ship/s/(scot %p p.c))
+      %emph  (frond emph/s/p.c)
+    ==
+  ::
+  ++  seam
+    |=  s=seam:h
+    %+  frond  -.s
+    ^-  json
+    ?-  -.s
+      %all    ~
+      %group  s/(flag flag.s)
+      %desk   s/desk.s
+    ==
+  ::
+  ++  flag
+    |=  f=flag:h
+    (rap 3 (scot %p p.f) '/' q.f ~)
+  ::
+  ++  nest
+    |=  n=nest:h
+    (rap 3 p.n '/' (flag q.n) ~)
+  ::
+  ++  rope
+    |=  r=rope:h
+    ^-  json
+    %-  pairs
+    :~  group/?~(gop.r ~ s/(flag u.gop.r))
+        channel/?~(can.r ~ s/(nest u.can.r))
+        desk/s/des.r
+        thread/s/(spat ted.r)
+    ==
+  --
+::
+++  dejs
+  =,  dejs:format
+  |%
+  ++  action
+    ^-  $-(json action:h)
+    %-  of
+    :~  saw-seam/seam
+        saw-rope/rope
+    ==
+  ::
+  ++  seam
+    %-  of
+    :~  all/ul
+        desk/so
+        group/flag
+    ==
+  ::
+  ++  flag  (su ;~((glue fas) ;~(pfix sig fed:ag) ^sym))
+  ++  nest  (su ;~((glue fas) ^sym ;~(pfix sig fed:ag) 
+  ::
+  ++  rope
+    %-  ot
+    :~  group/(mu flag)
+        channel/(mu nest)
+        desk/so
+        thread/pa
+    ==
+  --
+--
diff --git a/desk/mar/hark/action.hoon b/desk/mar/hark/action.hoon
index 41badeb..ca7b0a3 100644
--- a/desk/mar/hark/action.hoon
+++ b/desk/mar/hark/action.hoon
@@ -1,13 +1,15 @@
-/+  *hark-store
-|_  act=action
+/-  h=hark
+/+  j=hark-json
+|_  =action:h
 ++  grad  %noun
 ++  grow
   |%
-  ++  noun  act
+  ++  noun  action
+  ++  json  (action:enjs:j action)
   --
 ++  grab
   |%
-  ++  noun  action
-  ++  json  action:dejs
+  ++  noun  action:h
+  ++  json  action:dejs:j
   --
 --
diff --git a/desk/mar/hark/blanket.hoon b/desk/mar/hark/blanket.hoon
new file mode 100644
index 0000000..ab09582
--- /dev/null
+++ b/desk/mar/hark/blanket.hoon
@@ -0,0 +1,14 @@
+/-  h=hark
+/+  j=hark-json
+|_  =blanket:h
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  blanket
+  ++  json  (blanket:enjs:j blanket)
+  --
+++  grab
+  |%
+  ++  noun  blanket:h
+  --
+--
diff --git a/desk/mar/hark/carpet.hoon b/desk/mar/hark/carpet.hoon
new file mode 100644
index 0000000..9c4d93a
--- /dev/null
+++ b/desk/mar/hark/carpet.hoon
@@ -0,0 +1,14 @@
+/-  h=hark
+/+  j=hark-json
+|_  =carpet:h
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  carpet
+  ++  json  (carpet:enjs:j carpet)
+  --
+++  grab
+  |%
+  ++  noun  carpet:h
+  --
+--
diff --git a/desk/mar/hark/skeins.hoon b/desk/mar/hark/skeins.hoon
new file mode 100644
index 0000000..301aaeb
--- /dev/null
+++ b/desk/mar/hark/skeins.hoon
@@ -0,0 +1,14 @@
+/-  h=hark
+/+  j=hark-json
+|_  skeins=(list skein:h)
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  skeins
+  ++  json  (skeins:enjs:j skeins)
+  --
+++  grab
+  |%
+  ++  noun  (list skein:h)
+  --
+--
diff --git a/desk/mar/hark/update.hoon b/desk/mar/hark/update.hoon
deleted file mode 100644
index 10fca13..0000000
--- a/desk/mar/hark/update.hoon
+++ /dev/null
@@ -1,13 +0,0 @@
-/+  *hark-store
-|_  upd=update
-++  grad  %noun
-++  grow
-  |%
-  ++  noun  upd
-  ++  json  (update:enjs upd)
-  --
-++  grab
-  |%
-  ++  noun  update
-  --
---
diff --git a/desk/mar/hark/yarn.hoon b/desk/mar/hark/yarn.hoon
new file mode 100644
index 0000000..9a4496f
--- /dev/null
+++ b/desk/mar/hark/yarn.hoon
@@ -0,0 +1,14 @@
+/-  h=hark
+/+  j=hark-json
+|_  =yarn:h
+++  grad  %noun
+++  grow
+  |%
+  ++  noun  yarn
+  ++  json  (yarn:enjs:j yarn)
+  --
+++  grab
+  |%
+  ++  noun  yarn:h
+  --
+--
diff --git a/desk/sur/hark.hoon b/desk/sur/hark.hoon
new file mode 100644
index 0000000..c6e2006
--- /dev/null
+++ b/desk/sur/hark.hoon
@@ -0,0 +1,112 @@
+|%
+::  $rope: notification origin
+::    
+::    Shows where a notification has come from. Used to group
+::    notifications into threads
++$  rope
+  $:  gop=(unit flag)                 :: originating group
+      can=(unit nest:g)               :: originating channel
+      des=desk                        :: originating desk
+      ted=path                        :: threading identifer
+  ==
+::  $thread: notification group
+::
++$  thread  (set id)
+::  $id: notification identifier
++$  id   @uvH
+::  $yarn: notification
++$  yarn
+  $:  =id
+      rop=rope                       :: origin
+      tim=time                       :: time sent
+      con=(list content)             :: content of notification
+      wer=path                       :: where to link to in FE
+      but=(unit button)              :: action, if any
+  ==
+::
++$  button
+  $:  title=cord
+      handler=path
+  ==
++$  flag  (pair ship term)
+::  $content: notification text to be rendered
++$  content
+  $@  @t
+  $%  [%ship p=ship]
+      [%emph p=cord]
+  ==
+::  $action: Actions for hark
+::  
+::    %add-yarn adds a notification to the relevant inboxes, indicated
+::    by the loobs in the type
+::    %saw-seam marks all notifications in an inbox as unread
+::    %saw-rope marks a particular rope as read in all inboxes
+::
++$  action
+  $%  [%add-yarn all=? desk=? =yarn] 
+      [%saw-seam =seam]
+      [%saw-rope =rope]
+  ==
+::
++$  update
+  $:  yarns=(map id yarn)
+      =seam
+      threads=(map time thread)
+  ==
+::
++$  carpet
+  $:  =seam
+      yarns=(map id yarn)
+      cable=(map rope thread)
+      stitch=@ud
+  ==
++$  blanket
+  $:  =seam
+      yarns=(map id yarn)
+      =quilt
+  ==
+::  $seam: inbox identifier
+::
+::    All notifications end up in one of these inboxes
++$  seam
+  $%  [%group =flag]
+      [%desk =desk]
+      [%all ~]
+  ==
+::  $rug: notifications inbox
+::  
+::    .new contains all "unread" notifications, grouped by $rope
+::    .qul is an archive
+::
++$  rug
+  [new=(map rope thread) qul=quilt]
+++  quilt
+  =<  quilt
+  |%
+  ::  $quilt: inbox archive
+  ::  
+  ::    Threads are keyed by an autoincrementing counter that starts at
+  ::    0
+  ::
+  +$  quilt  ((mop @ud thread) lte)
+  ++  on  ((^on @ud thread) lte)
+  --
+::
+++  skein
+  $:  =time
+      count=@ud
+      ship-count=@ud
+      top=yarn
+      unread=?
+  ==
+::
+::  pulled from groups
+::
+::  $flag: ID for a group
+::
++$  flag  (pair ship term)
+::
+::  $nest: ID for a channel, {app}/{ship}/{name}
+::
++$  nest  (pair dude:gall flag)
+--