mirror of
https://github.com/tloncorp/landscape.git
synced 2024-12-24 17:22:53 +03:00
hark: pulling from new groups
This commit is contained in:
Hunter Miller
parent
4419b5cd5e
commit
ff5fabfcff
407
desk/app/hark.hoon
Normal file
407
desk/app/hark.hoon
Normal file
@ -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
|
||||||
|
--
|
||||||
|
--
|
||||||
14
desk/gen/hark/add-note.hoon
Normal file
14
desk/gen/hark/add-note.hoon
Normal file
@ -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]
|
||||||
8
desk/gen/hark/saw-rope.hoon
Normal file
8
desk/gen/hark/saw-rope.hoon
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
/- h=hark
|
||||||
|
:- %say
|
||||||
|
|= $: [now=@da eny=@uvJ =beak]
|
||||||
|
[[=rope:h ~] ~]
|
||||||
|
==
|
||||||
|
:- %hark-action
|
||||||
|
^- action:h
|
||||||
|
[%saw-rope rope]
|
||||||
8
desk/gen/hark/saw-seam.hoon
Normal file
8
desk/gen/hark/saw-seam.hoon
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
/- h=hark
|
||||||
|
:- %say
|
||||||
|
|= $: [now=@da eny=@uvJ =beak]
|
||||||
|
[[=seam:h ~] ~]
|
||||||
|
==
|
||||||
|
:- %hark-action
|
||||||
|
^- action:h
|
||||||
|
[%saw-seam seam]
|
||||||
185
desk/lib/hark-json.hoon
Normal file
185
desk/lib/hark-json.hoon
Normal file
@ -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
|
||||||
|
==
|
||||||
|
--
|
||||||
|
--
|
||||||
@ -1,13 +1,15 @@
|
|||||||
/+ *hark-store
|
/- h=hark
|
||||||
|_ act=action
|
/+ j=hark-json
|
||||||
|
|_ =action:h
|
||||||
++ grad %noun
|
++ grad %noun
|
||||||
++ grow
|
++ grow
|
||||||
|%
|
|%
|
||||||
++ noun act
|
++ noun action
|
||||||
|
++ json (action:enjs:j action)
|
||||||
--
|
--
|
||||||
++ grab
|
++ grab
|
||||||
|%
|
|%
|
||||||
++ noun action
|
++ noun action:h
|
||||||
++ json action:dejs
|
++ json action:dejs:j
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
|||||||
14
desk/mar/hark/blanket.hoon
Normal file
14
desk/mar/hark/blanket.hoon
Normal file
@ -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
|
||||||
|
--
|
||||||
|
--
|
||||||
14
desk/mar/hark/carpet.hoon
Normal file
14
desk/mar/hark/carpet.hoon
Normal file
@ -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
|
||||||
|
--
|
||||||
|
--
|
||||||
14
desk/mar/hark/skeins.hoon
Normal file
14
desk/mar/hark/skeins.hoon
Normal file
@ -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)
|
||||||
|
--
|
||||||
|
--
|
||||||
@ -1,13 +0,0 @@
|
|||||||
/+ *hark-store
|
|
||||||
|_ upd=update
|
|
||||||
++ grad %noun
|
|
||||||
++ grow
|
|
||||||
|%
|
|
||||||
++ noun upd
|
|
||||||
++ json (update:enjs upd)
|
|
||||||
--
|
|
||||||
++ grab
|
|
||||||
|%
|
|
||||||
++ noun update
|
|
||||||
--
|
|
||||||
--
|
|
||||||
14
desk/mar/hark/yarn.hoon
Normal file
14
desk/mar/hark/yarn.hoon
Normal file
@ -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
|
||||||
|
--
|
||||||
|
--
|
||||||
112
desk/sur/hark.hoon
Normal file
112
desk/sur/hark.hoon
Normal file
@ -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)
|
||||||
|
--
|
||||||
Loading…
Reference in New Issue
Block a user