mirror of
https://github.com/tloncorp/landscape.git
synced 2024-11-28 20:35:35 +03:00
Merge pull request #142 from tloncorp/hm/desk-renaming
meta: the final migration
This commit is contained in:
Hunter Miller
GitHub
commit
d499216289
2
.github/workflows/deploy-canary.yml
vendored
2
.github/workflows/deploy-canary.yml
vendored
@ -20,7 +20,7 @@ jobs:
|
||||
uses: "google-github-actions/setup-gcloud@v1"
|
||||
- id: deploy
|
||||
name: Deploy
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape garden binnec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape landscape binnec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
env:
|
||||
SSH_SEC_KEY: ${{ secrets.GCP_SSH_SEC_KEY }}
|
||||
SSH_PUB_KEY: ${{ secrets.GCP_SSH_PUB_KEY }}
|
||||
|
||||
2
.github/workflows/deploy-external.yml
vendored
2
.github/workflows/deploy-external.yml
vendored
@ -20,7 +20,7 @@ jobs:
|
||||
uses: "google-github-actions/setup-gcloud@v1"
|
||||
- id: deploy
|
||||
name: Deploy
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape garden doznec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape landscape doznec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
env:
|
||||
SSH_SEC_KEY: ${{ secrets.GCP_SSH_SEC_KEY }}
|
||||
SSH_PUB_KEY: ${{ secrets.GCP_SSH_PUB_KEY }}
|
||||
|
||||
2
.github/workflows/deploy-internal.yml
vendored
2
.github/workflows/deploy-internal.yml
vendored
@ -20,7 +20,7 @@ jobs:
|
||||
uses: "google-github-actions/setup-gcloud@v1"
|
||||
- id: deploy
|
||||
name: Deploy
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape garden marnec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
run: ./.github/helpers/deploy.sh tloncorp/landscape landscape marnec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
env:
|
||||
SSH_SEC_KEY: ${{ secrets.GCP_SSH_SEC_KEY }}
|
||||
SSH_PUB_KEY: ${{ secrets.GCP_SSH_PUB_KEY }}
|
||||
|
||||
4
.github/workflows/deploy-live.yml
vendored
4
.github/workflows/deploy-live.yml
vendored
@ -9,7 +9,7 @@ on:
|
||||
jobs:
|
||||
deploy:
|
||||
runs-on: ubuntu-latest
|
||||
name: "Release to ~mister-dister-dozzod-dozzod (livenet)"
|
||||
name: "Release to ~lander-dister-dozzod-dozzod (livenet)"
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
- id: 'auth'
|
||||
@ -21,7 +21,7 @@ jobs:
|
||||
- id: deploy
|
||||
name: Deploy
|
||||
run:
|
||||
./.github/helpers/deploy.sh tloncorp/landscape garden mister-dister-dozzod-dozzod us-central1-b mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
./.github/helpers/deploy.sh tloncorp/landscape landscape mister-dister-dozzod-dozzod us-central1-b mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
env:
|
||||
SSH_SEC_KEY: ${{ secrets.GCP_SSH_SEC_KEY }}
|
||||
SSH_PUB_KEY: ${{ secrets.GCP_SSH_PUB_KEY }}
|
||||
|
||||
4
.github/workflows/deploy.yml
vendored
4
.github/workflows/deploy.yml
vendored
@ -67,7 +67,7 @@ jobs:
|
||||
deploy:
|
||||
runs-on: ubuntu-latest
|
||||
needs: glob
|
||||
name: "Deploy a glob to ~wannec-dozzod-marzod (devstream)"
|
||||
name: "Deploy a glob to ~wannec-dozzod-marnus (devstream)"
|
||||
steps:
|
||||
- uses: actions/checkout@v3
|
||||
with:
|
||||
@ -82,7 +82,7 @@ jobs:
|
||||
- id: deploy
|
||||
name: Deploy
|
||||
run:
|
||||
./.github/helpers/deploy.sh tloncorp/landscape garden wannec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
./.github/helpers/deploy.sh tloncorp/landscape landscape wannec-dozzod-marnus us-central1-a mainnet-tlon-other-2d ${{ github.event.inputs.tag }}
|
||||
env:
|
||||
SSH_SEC_KEY: ${{ secrets.GCP_SSH_SEC_KEY }}
|
||||
SSH_PUB_KEY: ${{ secrets.GCP_SSH_PUB_KEY }}
|
||||
|
||||
@ -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
|
||||
==
|
||||
--
|
||||
--
|
||||
@ -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)]
|
||||
==
|
||||
--
|
||||
|
||||
@ -112,7 +112,7 @@
|
||||
:_ this
|
||||
:~ :* %pass /save-summary/(scot %p src.bowl)/(scot %da requested.u.result)
|
||||
%arvo %k %fard
|
||||
%garden %save-summary %noun
|
||||
%landscape %save-summary %noun
|
||||
!>(`[tlon.api mailchimp.api src.bowl summary.u.result])
|
||||
==
|
||||
==
|
||||
|
||||
508
desk/app/contacts.hoon
Normal file
508
desk/app/contacts.hoon
Normal file
@ -0,0 +1,508 @@
|
||||
/- *contacts
|
||||
/+ default-agent, dbug, verb
|
||||
:: performance, keep warm
|
||||
/+ contacts-json
|
||||
::
|
||||
|%
|
||||
:: conventions
|
||||
::
|
||||
:: .con: a contact
|
||||
:: .rof: our profile
|
||||
:: .rol: our full rolodex
|
||||
:: .for: foreign profile
|
||||
:: .sag: foreign subscription state
|
||||
::
|
||||
+| %types
|
||||
+$ card card:agent:gall
|
||||
+$ state-0 [%0 rof=$@(~ profile) rol=rolodex]
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
%+ verb &
|
||||
^- agent:gall
|
||||
=| state-0
|
||||
=* state -
|
||||
::
|
||||
=< |_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
cor ~(. raw bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
=^ cards state abet:init:cor
|
||||
[cards this]
|
||||
::
|
||||
++ on-save !>([state okay])
|
||||
::
|
||||
++ on-load
|
||||
|= old=vase
|
||||
^- (quip card _this)
|
||||
=^ cards state abet:(load:cor old)
|
||||
[cards this]
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
=^ cards state abet:(peer:cor path)
|
||||
[cards this]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
=^ cards state abet:(poke:cor mark vase)
|
||||
[cards this]
|
||||
::
|
||||
++ on-peek peek:cor
|
||||
++ on-leave on-leave:def
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
=^ cards state abet:(agent:cor wire sign)
|
||||
[cards this]
|
||||
::
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
::
|
||||
|%
|
||||
::
|
||||
+| %help
|
||||
::
|
||||
++ do-edit
|
||||
|= [c=contact f=field]
|
||||
^+ c
|
||||
?- -.f
|
||||
%nickname c(nickname nickname.f)
|
||||
%bio c(bio bio.f)
|
||||
%status c(status status.f)
|
||||
%color c(color color.f)
|
||||
::
|
||||
%avatar ~| "cannot add a data url to avatar!"
|
||||
?> ?| ?=(~ avatar.f)
|
||||
!=('data:' (end 3^5 u.avatar.f))
|
||||
==
|
||||
c(avatar avatar.f)
|
||||
::
|
||||
%cover ~| "cannot add a data url to cover!"
|
||||
?> ?| ?=(~ cover.f)
|
||||
!=('data:' (end 3^5 u.cover.f))
|
||||
==
|
||||
c(cover cover.f)
|
||||
::
|
||||
%add-group c(groups (~(put in groups.c) flag.f))
|
||||
::
|
||||
%del-group c(groups (~(del in groups.c) flag.f))
|
||||
==
|
||||
::
|
||||
++ mono
|
||||
|= [old=@da new=@da]
|
||||
^- @da
|
||||
?: (lth old new) new
|
||||
(add old ^~((div ~s1 (bex 16))))
|
||||
::
|
||||
+| %state
|
||||
::
|
||||
:: namespaced to avoid accidental direct reference
|
||||
::
|
||||
++ raw
|
||||
=| out=(list card)
|
||||
|_ =bowl:gall
|
||||
::
|
||||
+| %generic
|
||||
::
|
||||
++ abet [(flop out) state]
|
||||
++ cor .
|
||||
++ emit |=(c=card cor(out [c out]))
|
||||
++ give |=(=gift:agent:gall (emit %give gift))
|
||||
++ pass |=([=wire =note:agent:gall] (emit %pass wire note))
|
||||
::
|
||||
+| %operations
|
||||
::
|
||||
:: |pub: publication mgmt
|
||||
::
|
||||
:: - /news: local updates to our profile and rolodex
|
||||
:: - /contact: updates to our profile
|
||||
::
|
||||
:: as these publications are trivial, |pub does *not*
|
||||
:: make use of the +abet pattern. the only behavior of note
|
||||
:: is wrt the /contact/at/$date path, which exists to minimize
|
||||
:: redundant network traffic.
|
||||
::
|
||||
:: /epic protocol versions are even more trivial,
|
||||
:: published ad-hoc, elsewhere.
|
||||
::
|
||||
++ pub
|
||||
=> |%
|
||||
:: if this proves to be too slow, the set of paths
|
||||
:: should be maintained statefully: put on +p-init:pub,
|
||||
:: filtered at some interval (on +load?) to avoid a space leak.
|
||||
::
|
||||
++ subs
|
||||
^- (set path)
|
||||
%- ~(rep by sup.bowl)
|
||||
|= [[duct ship pat=path] acc=(set path)]
|
||||
?.(?=([%contact *] pat) acc (~(put in acc) pat))
|
||||
::
|
||||
++ fact
|
||||
|= [pat=(set path) u=update]
|
||||
^- gift:agent:gall
|
||||
[%fact ~(tap in pat) upd:mar !>(u)]
|
||||
--
|
||||
::
|
||||
|%
|
||||
++ p-anon ?.(?=([@ ^] rof) cor (p-diff ~))
|
||||
::
|
||||
++ p-edit
|
||||
|= l=(list field)
|
||||
=/ old ?.(?=([@ ^] rof) *contact con.rof)
|
||||
=/ new (roll l |=([f=field c=_old] (do-edit c f)))
|
||||
?: =(old new)
|
||||
cor
|
||||
(p-diff:pub new)
|
||||
::
|
||||
++ p-diff
|
||||
|= con=$@(~ contact)
|
||||
=/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con]
|
||||
(give:(p-news(rof p) our.bowl con) (fact subs full+p))
|
||||
::
|
||||
++ p-init
|
||||
|= wen=(unit @da)
|
||||
?~ rof cor
|
||||
?~ wen (give (fact ~ full+rof))
|
||||
?: =(u.wen wen.rof) cor
|
||||
?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs
|
||||
::
|
||||
++ p-news |=(n=news (give %fact [/news ~] %contact-news !>(n)))
|
||||
--
|
||||
::
|
||||
:: +sub: subscription mgmt
|
||||
::
|
||||
:: /epic: foreign protocol versions, |si-epic:s-impl
|
||||
:: /contact/*: foreign profiles, |s-impl
|
||||
::
|
||||
:: subscription state is tracked per peer in .sag
|
||||
::
|
||||
:: ~: no subscription
|
||||
:: %want: /contact/* being attempted
|
||||
:: %fail: /contact/* failed, /epic being attempted
|
||||
:: %lost: /epic failed
|
||||
:: %chi: /contact/* established
|
||||
:: %lev: we're (incompatibly) ahead of the publisher
|
||||
:: %dex: we're behind the publisher
|
||||
::
|
||||
:: for a given peer, we always have at most one subscription,
|
||||
:: to either /contact/* or /epic.
|
||||
::
|
||||
++ sub
|
||||
|^ |= who=ship
|
||||
^+ s-impl
|
||||
?< =(our.bowl who)
|
||||
=/ old (~(get by rol) who)
|
||||
~(. s-impl who %live ?=(~ old) (fall old [~ ~]))
|
||||
::
|
||||
++ s-many
|
||||
|= [l=(list ship) f=$-(_s-impl _s-impl)]
|
||||
^+ cor
|
||||
%+ roll l
|
||||
|= [who=@p acc=_cor]
|
||||
?: =(our.bowl who) acc
|
||||
si-abet:(f (sub:acc who))
|
||||
::
|
||||
++ s-impl
|
||||
|_ [who=ship sas=?(%dead %live) new=? foreign]
|
||||
::
|
||||
++ si-cor .
|
||||
::
|
||||
++ si-abet
|
||||
^+ cor
|
||||
?- sas
|
||||
%live =. rol (~(put by rol) who for sag)
|
||||
:: NB: this assumes con.for is only set in +si-hear
|
||||
::
|
||||
?.(new cor (p-news:pub who ~))
|
||||
::
|
||||
%dead ?: new cor
|
||||
=. rol (~(del by rol) who)
|
||||
::
|
||||
:: this is not quite right, reflecting *total* deletion
|
||||
:: as *contact* deletion. but it's close, and keeps /news simpler
|
||||
::
|
||||
(p-news:pub who ~)
|
||||
==
|
||||
::
|
||||
++ si-take
|
||||
|= =sign:agent:gall
|
||||
^+ si-cor
|
||||
?- -.sign
|
||||
%poke-ack ~|(strange-poke-ack+wire !!)
|
||||
::
|
||||
%watch-ack ~| strange-watch-ack+wire
|
||||
?> ?=(%want sag)
|
||||
?~ p.sign si-cor(sag [%chi ~])
|
||||
%- (slog 'contact-fail' u.p.sign)
|
||||
pe-peer:si-epic(sag %fail)
|
||||
::
|
||||
%kick si-heed
|
||||
::
|
||||
:: [compat] we *should* maintain backcompat here
|
||||
::
|
||||
:: by either directly handling or upconverting
|
||||
:: old actions. but if we don't, we'll fall back
|
||||
:: to /epic and wait for our peer to upgrade.
|
||||
::
|
||||
:: %fact's from the future are also /epic,
|
||||
:: in case our peer downgrades. if not, we'll
|
||||
:: handle it on +load.
|
||||
::
|
||||
%fact ?+ p.cage.sign (si-odd p.cage.sign)
|
||||
?(upd:base:mar %contact-update-0)
|
||||
(si-hear !<(update q.cage.sign))
|
||||
== ==
|
||||
|
||||
++ si-hear
|
||||
|= u=update
|
||||
^+ si-cor
|
||||
?: &(?=(^ for) (lte wen.u wen.for))
|
||||
si-cor
|
||||
si-cor(for +.u, cor (p-news:pub who con.u))
|
||||
::
|
||||
++ si-meet si-cor :: init key in +si-abet
|
||||
::
|
||||
++ si-heed
|
||||
^+ si-cor
|
||||
?. ?=(~ sag)
|
||||
si-cor
|
||||
=/ pat [%contact ?~(for / /at/(scot %da wen.for))]
|
||||
%= si-cor
|
||||
cor (pass /contact %agent [who dap.bowl] %watch pat)
|
||||
sag %want
|
||||
==
|
||||
::
|
||||
++ si-drop si-snub(sas %dead)
|
||||
::
|
||||
++ si-snub
|
||||
%_ si-cor
|
||||
sag ~
|
||||
cor ?+ sag cor
|
||||
?(%fail [?(%lev %dex) *])
|
||||
(pass /epic %agent [who dap.bowl] %leave ~)
|
||||
::
|
||||
?(%want [%chi *])
|
||||
(pass /contact %agent [who dap.bowl] %leave ~)
|
||||
== ==
|
||||
::
|
||||
++ si-odd
|
||||
|= =mark
|
||||
^+ si-cor
|
||||
=* upd *upd:base:mar
|
||||
=* wid ^~((met 3 upd))
|
||||
?. =(upd (end [3 wid] mark))
|
||||
~&(fake-news+mark si-cor) :: XX unsub?
|
||||
?~ ver=(slaw %ud (rsh 3^+(wid) mark))
|
||||
~&(weird-news+mark si-cor) :: XX unsub?
|
||||
?: =(okay u.ver)
|
||||
~|(odd-not-odd+mark !!) :: oops!
|
||||
=. si-cor si-snub :: unsub before .sag update
|
||||
=. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver])
|
||||
pe-peer:si-epic
|
||||
::
|
||||
++ si-epic
|
||||
|%
|
||||
++ pe-take
|
||||
|= =sign:agent:gall
|
||||
^+ si-cor
|
||||
?- -.sign
|
||||
%poke-ack ~|(strange-poke-ack+wire !!)
|
||||
::
|
||||
%watch-ack ?~ p.sign si-cor
|
||||
%- (slog 'epic-fail' u.p.sign)
|
||||
si-cor(sag %lost)
|
||||
::
|
||||
%kick ?. ?=(?(%fail [?(%dex %lev) *]) sag)
|
||||
si-cor :: XX strange
|
||||
pe-peer
|
||||
::
|
||||
%fact ?+ p.cage.sign
|
||||
~&(fact-not-epic+p.cage.sign si-cor)
|
||||
%epic (pe-hear !<(epic q.cage.sign))
|
||||
== ==
|
||||
::
|
||||
++ pe-hear
|
||||
|= =epic
|
||||
^+ si-cor
|
||||
?. ?=(?(%fail [?(%dex %lev) *]) sag)
|
||||
~|(strange-epic+[okay epic] !!) :: get %kick'd
|
||||
?: =(okay epic)
|
||||
?: ?=(%fail sag)
|
||||
si-cor(sag %lost) :: abandon hope
|
||||
si-heed:si-snub
|
||||
::
|
||||
:: handled generically to support peer downgrade
|
||||
::
|
||||
si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~]))
|
||||
::
|
||||
++ pe-peer
|
||||
si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic))
|
||||
--
|
||||
--
|
||||
--
|
||||
:: +migrate: from :contact-store
|
||||
::
|
||||
:: all known ships, non-default profiles, no subscriptions
|
||||
::
|
||||
++ migrate
|
||||
=> |%
|
||||
++ legacy
|
||||
|%
|
||||
+$ rolodex (map ship contact)
|
||||
+$ resource [=entity name=term]
|
||||
+$ entity ship
|
||||
+$ contact
|
||||
$: nickname=@t
|
||||
bio=@t
|
||||
status=@t
|
||||
color=@ux
|
||||
avatar=(unit @t)
|
||||
cover=(unit @t)
|
||||
groups=(set resource)
|
||||
last-updated=@da
|
||||
==
|
||||
--
|
||||
--
|
||||
::
|
||||
^+ cor
|
||||
=/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl)
|
||||
?. .^(? gu+(weld bas /$)) cor
|
||||
=/ ful .^(rolodex:legacy gx+(weld bas /all/noun))
|
||||
::
|
||||
|^ cor(rof us, rol them)
|
||||
++ us (biff (~(get by ful) our.bowl) convert)
|
||||
::
|
||||
++ them
|
||||
^- rolodex
|
||||
%- ~(rep by (~(del by ful) our.bowl))
|
||||
|= [[who=ship con=contact:legacy] rol=rolodex]
|
||||
(~(put by rol) who (convert con) ~)
|
||||
::
|
||||
++ convert
|
||||
|= con=contact:legacy
|
||||
^- $@(~ profile)
|
||||
?: =(*contact:legacy con) ~
|
||||
[last-updated.con con(|6 groups.con)]
|
||||
--
|
||||
::
|
||||
+| %implementation
|
||||
::
|
||||
++ init
|
||||
(emit %pass /migrate %agent [our dap]:bowl %poke noun+!>(%migrate))
|
||||
::
|
||||
++ load
|
||||
|= old-vase=vase
|
||||
^+ cor
|
||||
|^ =+ !<([old=versioned-state cool=epic] old-vase)
|
||||
=. state
|
||||
?- -.old
|
||||
%0 old
|
||||
==
|
||||
:: [compat] if our protocol version changed
|
||||
::
|
||||
:: we first tell the world, then see if we can now understand
|
||||
:: any of our friends who were sending messages from the future.
|
||||
::
|
||||
?:(=(okay cool) cor l-bump(cor l-epic))
|
||||
::
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
==
|
||||
::
|
||||
++ l-epic (give %fact [/epic ~] epic+!>(okay))
|
||||
::
|
||||
++ l-bump
|
||||
^+ cor
|
||||
%- ~(rep by rol)
|
||||
|= [[who=ship foreign] =_cor]
|
||||
:: XX to fully support downgrade, we'd need to also
|
||||
:: save an epic in %lev
|
||||
::
|
||||
?. ?& ?=([%dex *] sag)
|
||||
=(okay ver.sag)
|
||||
==
|
||||
cor
|
||||
si-abet:si-heed:si-snub:(sub:cor who)
|
||||
--
|
||||
::
|
||||
++ poke
|
||||
|= [=mark =vase]
|
||||
^+ cor
|
||||
:: [compat] we *should* maintain backcompat here
|
||||
::
|
||||
:: by either directly handling or upconverting old actions
|
||||
::
|
||||
?+ mark ~|(bad-mark+mark !!)
|
||||
%noun
|
||||
?+ q.vase !!
|
||||
%migrate migrate
|
||||
==
|
||||
::
|
||||
?(act:base:mar %contact-action-0)
|
||||
?> =(our src):bowl
|
||||
=/ act !<(action vase)
|
||||
?- -.act
|
||||
%anon p-anon:pub
|
||||
%edit (p-edit:pub p.act)
|
||||
%meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s))
|
||||
%heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s))
|
||||
%drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s))
|
||||
%snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s))
|
||||
==
|
||||
==
|
||||
::
|
||||
++ peek
|
||||
|= pat=(pole knot)
|
||||
^- (unit (unit cage))
|
||||
?+ pat [~ ~]
|
||||
[%x %all ~]
|
||||
=/ lor=rolodex
|
||||
?: |(?=(~ rof) ?=(~ con.rof)) rol
|
||||
(~(put by rol) our.bowl rof ~)
|
||||
``contact-rolodex+!>(lor)
|
||||
::
|
||||
[%x %contact her=@ ~]
|
||||
?~ who=`(unit @p)`(slaw %p her.pat)
|
||||
[~ ~]
|
||||
=/ tac=?(~ contact)
|
||||
?: =(our.bowl u.who) ?~(rof ~ con.rof)
|
||||
=+ (~(get by rol) u.who)
|
||||
?: |(?=(~ -) ?=(~ for.u.-)) ~
|
||||
con.for.u.-
|
||||
?~ tac [~ ~]
|
||||
``contact+!>(`contact`tac)
|
||||
==
|
||||
::
|
||||
++ peer
|
||||
|= pat=(pole knot)
|
||||
^+ cor
|
||||
?+ pat ~|(bad-watch-path+pat !!)
|
||||
[%contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat))
|
||||
[%contact ~] (p-init:pub ~)
|
||||
[%epic ~] (give %fact ~ epic+!>(okay))
|
||||
[%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor))
|
||||
==
|
||||
::
|
||||
++ agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^+ cor
|
||||
?+ wire ~|(evil-agent+wire !!)
|
||||
[%contact ~] si-abet:(si-take:(sub src.bowl) sign)
|
||||
[%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign)
|
||||
::
|
||||
[%migrate ~]
|
||||
?> ?=(%poke-ack -.sign)
|
||||
?~ p.sign cor
|
||||
%- (slog leaf/"{<wire>} failed" u.p.sign)
|
||||
cor
|
||||
==
|
||||
--
|
||||
--
|
||||
@ -174,11 +174,9 @@
|
||||
=^ cards state
|
||||
?+ path (on-watch:def path)
|
||||
[%http-response *]
|
||||
?> (team:title [our src]:bowl)
|
||||
`state
|
||||
::
|
||||
[%charges ~]
|
||||
?> (team:title [our src]:bowl)
|
||||
`state
|
||||
::
|
||||
[%glob @ @ ~]
|
||||
@ -506,7 +504,7 @@
|
||||
::
|
||||
++ handle-get-request
|
||||
^- simple-payload:http
|
||||
?+ [site ext]:req-line (redirect:gen '/apps/grid/')
|
||||
?+ [site ext]:req-line (redirect:gen '/apps/landscape/')
|
||||
[[%session ~] [~ %js]]
|
||||
%- inline-js-response
|
||||
(rap 3 'window.ship = "' (rsh 3 (scot %p our.bowl)) '";' ~)
|
||||
|
||||
@ -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])
|
||||
--
|
||||
@ -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]
|
||||
/
|
||||
==
|
||||
--
|
||||
--
|
||||
427
desk/app/hark.hoon
Normal file
427
desk/app/hark.hoon
Normal file
@ -0,0 +1,427 @@
|
||||
/- h=hark
|
||||
/+ default-agent, verb, dbug
|
||||
/+ mp=mop-extensions
|
||||
:: performance, keep warm
|
||||
/+ hark-json
|
||||
|%
|
||||
+$ 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 seam.act)
|
||||
%add-yarn (add-yarn +.act)
|
||||
==
|
||||
::
|
||||
%hark-action-1
|
||||
=+ !<(act=action-1:h vase)
|
||||
?+ -.act $(mark %hark-action)
|
||||
%new-yarn
|
||||
=/ =action:h
|
||||
:* %add-yarn
|
||||
all.act
|
||||
desk.act
|
||||
:* (end [7 1] (shax eny.bowl))
|
||||
rop.act
|
||||
now.bowl
|
||||
con.act
|
||||
wer.act
|
||||
but.act
|
||||
==
|
||||
==
|
||||
$(mark %hark-action, vase !>(action))
|
||||
==
|
||||
==
|
||||
++ 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 (~(gut by desks) desk.pole *rug:h))
|
||||
::
|
||||
[%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
|
||||
--
|
||||
--
|
||||
@ -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)]
|
||||
--
|
||||
@ -135,7 +135,7 @@
|
||||
%arvo
|
||||
%k
|
||||
%fard
|
||||
%garden :: XX: %landscape?
|
||||
%landscape
|
||||
%vitals-connection-check
|
||||
%noun
|
||||
!>(ship)
|
||||
@ -150,7 +150,7 @@
|
||||
%arvo
|
||||
%k
|
||||
%fard
|
||||
%garden :: XX: %landscape?
|
||||
%landscape
|
||||
%vitals-connection-check
|
||||
%noun
|
||||
!>(ship)
|
||||
|
||||
@ -1,12 +1,11 @@
|
||||
:~ %docket
|
||||
%treaty
|
||||
%hark-store
|
||||
%hark-system-hook
|
||||
%settings
|
||||
%settings-store
|
||||
%storage
|
||||
:~ %bait
|
||||
%contacts
|
||||
%docket
|
||||
%hark
|
||||
%reel
|
||||
%bait
|
||||
%settings
|
||||
%storage
|
||||
%treaty
|
||||
%vitals
|
||||
%growl
|
||||
==
|
||||
|
||||
@ -4,7 +4,7 @@
|
||||
glob-http+['https://bootstrap.urbit.org/glob-0v3.26u3l.bgtqj.v0tu0.t5kpu.91p45.glob' 0v3.26u3l.bgtqj.v0tu0.t5kpu.91p45]
|
||||
::glob-ames+~zod^0v0
|
||||
base+'grid'
|
||||
version+[1 15 0]
|
||||
version+[2 0 0]
|
||||
website+'https://tlon.io'
|
||||
license+'MIT'
|
||||
==
|
||||
|
||||
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]
|
||||
131
desk/lib/contacts-json.hoon
Normal file
131
desk/lib/contacts-json.hoon
Normal file
@ -0,0 +1,131 @@
|
||||
/- c=contacts, g=groups
|
||||
/+ gj=groups-json
|
||||
|%
|
||||
++ enjs
|
||||
=, enjs:format
|
||||
|%
|
||||
:: XX shadowed for compat, +ship:enjs removes the ~
|
||||
::
|
||||
++ ship
|
||||
|=(her=@p n+(rap 3 '"' (scot %p her) '"' ~))
|
||||
::
|
||||
++ action
|
||||
|= a=action:c
|
||||
^- json
|
||||
%+ frond -.a
|
||||
?- -.a
|
||||
%anon ~
|
||||
%edit a+(turn p.a field)
|
||||
%meet a+(turn p.a ship)
|
||||
%heed a+(turn p.a ship)
|
||||
%drop a+(turn p.a ship)
|
||||
%snub a+(turn p.a ship)
|
||||
==
|
||||
::
|
||||
++ contact
|
||||
|= c=contact:c
|
||||
^- json
|
||||
%- pairs
|
||||
:~ nickname+s+nickname.c
|
||||
bio+s+bio.c
|
||||
status+s+status.c
|
||||
color+s+(scot %ux color.c)
|
||||
avatar+?~(avatar.c ~ s+u.avatar.c)
|
||||
cover+?~(cover.c ~ s+u.cover.c)
|
||||
::
|
||||
=- groups+a+-
|
||||
%- ~(rep in groups.c)
|
||||
|=([f=flag:g j=(list json)] [s+(flag:enjs:gj f) j])
|
||||
==
|
||||
::
|
||||
++ field
|
||||
|= f=field:c
|
||||
^- json
|
||||
%+ frond -.f
|
||||
?- -.f
|
||||
%nickname s+nickname.f
|
||||
%bio s+bio.f
|
||||
%status s+status.f
|
||||
%color s+(rsh 3^2 (scot %ux color.f)) :: XX confirm
|
||||
%avatar ?~(avatar.f ~ s+u.avatar.f)
|
||||
%cover ?~(cover.f ~ s+u.cover.f)
|
||||
%add-group s+(flag:enjs:gj flag.f)
|
||||
%del-group s+(flag:enjs:gj flag.f)
|
||||
==
|
||||
::
|
||||
++ rolodex
|
||||
|= r=rolodex:c
|
||||
^- json
|
||||
%- pairs
|
||||
%- ~(rep by r)
|
||||
|= [[who=@p foreign:c] j=(list [@t json])]
|
||||
[[(scot %p who) ?.(?=([@ ^] for) ~ (contact con.for))] j] :: XX stale flag per sub state?
|
||||
::
|
||||
++ news
|
||||
|= n=news:c
|
||||
^- json
|
||||
%- pairs
|
||||
:~ who+(ship who.n)
|
||||
con+?~(con.n ~ (contact con.n))
|
||||
==
|
||||
--
|
||||
::
|
||||
++ dejs
|
||||
=, dejs:format
|
||||
|%
|
||||
:: for performance, @p is serialized above to json %n (no escape)
|
||||
:: for mark roundtrips, ships are parsed from either %s or %n
|
||||
:: XX do this elsewhere in groups?
|
||||
::
|
||||
++ ship (se-ne %p)
|
||||
++ se-ne
|
||||
|= aur=@tas
|
||||
|= jon=json
|
||||
?+ jon !!
|
||||
[%s *] (slav aur p.jon)
|
||||
::
|
||||
[%n *] ~| bad-n+p.jon
|
||||
=/ wyd (met 3 p.jon)
|
||||
?> ?& =('"' (end 3 p.jon))
|
||||
=('"' (cut 3 [(dec wyd) 1] p.jon))
|
||||
==
|
||||
(slav aur (cut 3 [1 (sub wyd 2)] p.jon))
|
||||
==
|
||||
::
|
||||
++ action
|
||||
^- $-(json action:c)
|
||||
%- of
|
||||
:~ anon+ul
|
||||
edit+(ar field)
|
||||
meet+(ar ship)
|
||||
heed+(ar ship)
|
||||
drop+(ar ship)
|
||||
snub+(ar ship)
|
||||
==
|
||||
::
|
||||
++ contact
|
||||
^- $-(json contact:c)
|
||||
%- ot
|
||||
:~ nickname+so
|
||||
bio+so
|
||||
status+so
|
||||
color+nu
|
||||
avatar+(mu so)
|
||||
cover+(mu so)
|
||||
groups+(as flag:dejs:gj)
|
||||
==
|
||||
::
|
||||
++ field
|
||||
^- $-(json field:c)
|
||||
%- of
|
||||
:~ nickname+so
|
||||
bio+so
|
||||
status+so
|
||||
color+nu
|
||||
avatar+(mu so)
|
||||
cover+(mu so)
|
||||
add-group+flag:dejs:gj
|
||||
del-group+flag:dejs:gj
|
||||
==
|
||||
--
|
||||
--
|
||||
21
desk/lib/groups-json.hoon
Normal file
21
desk/lib/groups-json.hoon
Normal file
@ -0,0 +1,21 @@
|
||||
/- g=groups
|
||||
|%
|
||||
++ enjs
|
||||
=, enjs:format
|
||||
|%
|
||||
++ flag
|
||||
|= f=flag:g
|
||||
(rap 3 (scot %p p.f) '/' q.f ~)
|
||||
::
|
||||
++ nest
|
||||
|= n=nest:g
|
||||
(rap 3 p.n '/' (flag q.n) ~)
|
||||
--
|
||||
++ dejs
|
||||
=, dejs:format
|
||||
|%
|
||||
++ ship (se %p)
|
||||
++ flag (su ;~((glue fas) ;~(pfix sig fed:ag) sym))
|
||||
++ nest (su ;~((glue fas) sym ;~(pfix sig fed:ag)))
|
||||
--
|
||||
--
|
||||
232
desk/lib/hark-json.hoon
Normal file
232
desk/lib/hark-json.hoon
Normal file
@ -0,0 +1,232 @@
|
||||
/- h=hark
|
||||
/+ groups-json
|
||||
|%
|
||||
++ 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 flag:enjs:groups-json
|
||||
++ nest nest:enjs:groups-json
|
||||
::
|
||||
++ 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
|
||||
%- of
|
||||
:~ saw-seam/seam
|
||||
saw-rope/rope
|
||||
add-yarn/add-yarn
|
||||
==
|
||||
++ action-1
|
||||
%- of
|
||||
:~ saw-seam/seam
|
||||
saw-rope/rope
|
||||
add-yarn/add-yarn
|
||||
new-yarn/new-yarn
|
||||
==
|
||||
::
|
||||
++ seam
|
||||
%- of
|
||||
:~ all/ul
|
||||
desk/so
|
||||
group/flag
|
||||
==
|
||||
::
|
||||
++ add-yarn
|
||||
%- ot
|
||||
:~ all/bo
|
||||
desk/bo
|
||||
yarn/yarn
|
||||
==
|
||||
::
|
||||
++ new-yarn
|
||||
%- ot
|
||||
:~ all/bo
|
||||
desk/bo
|
||||
rope/rope
|
||||
con/(ar content)
|
||||
wer/pa
|
||||
but/(mu button)
|
||||
==
|
||||
::
|
||||
++ button
|
||||
%- ot
|
||||
:~ title/so
|
||||
hanlder/pa
|
||||
==
|
||||
::
|
||||
++ content
|
||||
|= j=json
|
||||
^- content:h
|
||||
?: ?=([%s *] j) p.j
|
||||
=> .(j `json`j)
|
||||
%. j
|
||||
%- of
|
||||
:~ ship/ship
|
||||
emph/so
|
||||
==
|
||||
::
|
||||
++ yarn
|
||||
%- ot
|
||||
:~ id/(se %uvh)
|
||||
rope/rope
|
||||
time/(se %da)
|
||||
con/(ar content)
|
||||
wer/pa
|
||||
but/(mu button)
|
||||
==
|
||||
::
|
||||
++ flag flag:dejs:groups-json
|
||||
++ nest nest:dejs:groups-json
|
||||
++ ship ship:dejs:groups-json
|
||||
++ rope
|
||||
%- ot
|
||||
:~ group/(mu flag)
|
||||
channel/(mu nest)
|
||||
desk/so
|
||||
thread/pa
|
||||
==
|
||||
--
|
||||
--
|
||||
@ -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
|
||||
==
|
||||
--
|
||||
--
|
||||
@ -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)))
|
||||
--
|
||||
6
desk/lib/mark-warmer.hoon
Normal file
6
desk/lib/mark-warmer.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/$ rolo %contact-rolodex %json
|
||||
/$ contact %contact %json
|
||||
/$ skeins %hark-skeins %json
|
||||
/$ carpet %hark-carpet %json
|
||||
/$ blanket %hark-blanket %json
|
||||
~
|
||||
139
desk/lib/mop-extensions.hoon
Normal file
139
desk/lib/mop-extensions.hoon
Normal file
@ -0,0 +1,139 @@
|
||||
|* [key=mold val=mold]
|
||||
=> |%
|
||||
+$ item [key=key val=val]
|
||||
--
|
||||
~% %mope-comp ..zuse ~
|
||||
|= compare=$-([key key] ?)
|
||||
~% %mope-core ..zuse ~
|
||||
|%
|
||||
:: +bat: tabulate a subset excluding start element with a max count (backwards)
|
||||
::
|
||||
++ bat
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- (list item)
|
||||
|^
|
||||
e:(tabulate (del-span a b) b c)
|
||||
::
|
||||
++ tabulate
|
||||
|= [a=(tree item) b=(unit key) c=@]
|
||||
^- [d=@ e=(list item)]
|
||||
?: ?&(?=(~ b) =(c 0))
|
||||
[0 ~]
|
||||
=| f=[d=@ e=(list item)]
|
||||
|- ^+ f
|
||||
?: ?|(?=(~ a) =(d.f c)) f
|
||||
=. f $(a r.a)
|
||||
?: =(d.f c) f
|
||||
=. f [+(d.f) [n.a e.f]]
|
||||
?:(=(d.f c) f $(a l.a))
|
||||
::
|
||||
++ del-span
|
||||
|= [a=(tree item) b=(unit key)]
|
||||
^- (tree item)
|
||||
?~ a a
|
||||
?~ b a
|
||||
?: =(key.n.a u.b)
|
||||
l.a
|
||||
?. (compare key.n.a u.b)
|
||||
$(a l.a)
|
||||
a(r $(a r.a))
|
||||
--
|
||||
:: +dop: dip:on but in reverse order (right to left)
|
||||
::
|
||||
++ dop
|
||||
|* state=mold
|
||||
|= $: a=(tree item)
|
||||
=state
|
||||
f=$-([state item] [(unit val) ? state])
|
||||
==
|
||||
^+ [state a]
|
||||
:: acc: accumulator
|
||||
::
|
||||
:: .stop: set to %.y by .f when done traversing
|
||||
:: .state: threaded through each run of .f and produced by +abet
|
||||
::
|
||||
=/ acc [stop=`?`%.n state=state]
|
||||
=< abet =< main
|
||||
|%
|
||||
++ this .
|
||||
++ abet [state.acc a]
|
||||
:: +main: main recursive loop; performs a partial inorder traversal
|
||||
::
|
||||
++ main
|
||||
^+ this
|
||||
:: stop if empty or we've been told to stop
|
||||
::
|
||||
?: =(~ a) this
|
||||
?: stop.acc this
|
||||
:: reverse in-order traversal: right -> node -> left, until .f sets .stop
|
||||
::
|
||||
=. this right
|
||||
?: stop.acc this
|
||||
=^ del this node
|
||||
=? this !stop.acc left
|
||||
:: XX: remove for now; bring back when upstreaming
|
||||
:: =? a del (nip a)
|
||||
this
|
||||
:: +node: run .f on .n.a, updating .a, .state, and .stop
|
||||
::
|
||||
++ node
|
||||
^+ [del=*? this]
|
||||
:: run .f on node, updating .stop.acc and .state.acc
|
||||
::
|
||||
?> ?=(^ a)
|
||||
=^ res acc (f state.acc n.a)
|
||||
?~ res
|
||||
[del=& this]
|
||||
[del=| this(val.n.a u.res)]
|
||||
:: +left: recurse on left subtree, copying mutant back into .l.a
|
||||
::
|
||||
++ left
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ lef main(a l.a)
|
||||
lef(a a(l a.lef))
|
||||
:: +right: recurse on right subtree, copying mutant back into .r.a
|
||||
::
|
||||
++ right
|
||||
^+ this
|
||||
?~ a this
|
||||
=/ rig main(a r.a)
|
||||
rig(a a(r a.rig))
|
||||
--
|
||||
:: +bot: produce the N leftmost elements
|
||||
::
|
||||
++ bot
|
||||
|= [a=(tree item) b=@]
|
||||
^- (list item)
|
||||
|^ p:(items-with-remainder a b)
|
||||
++ items-with-remainder
|
||||
|= [a=(tree item) b=@]
|
||||
^- (pair (list item) @)
|
||||
?~ a [~ b]
|
||||
?: =(b 0) [~ 0]
|
||||
=/ left-result (items-with-remainder l.a b)
|
||||
?: =(q.left-result 0) left-result
|
||||
?: =(q.left-result 1) [(zing ~[p.left-result ~[n.a]]) (dec q.left-result)]
|
||||
=/ right-result
|
||||
(items-with-remainder r.a (dec q.left-result))
|
||||
[(zing ~[p.left-result ~[n.a] p.right-result]) q.right-result]
|
||||
--
|
||||
:: +top: produce the N rightmost elements
|
||||
::
|
||||
++ top
|
||||
|= [a=(tree item) b=@]
|
||||
^- (list item)
|
||||
|^ p:(items-with-remainder a b)
|
||||
++ items-with-remainder
|
||||
|= [a=(tree item) b=@]
|
||||
^- (pair (list item) @)
|
||||
?~ a [~ b]
|
||||
?: =(b 0) [~ 0]
|
||||
=/ right-result (items-with-remainder r.a b)
|
||||
?: =(q.right-result 0) right-result
|
||||
?: =(q.right-result 1) [[n.a p.right-result] (dec q.right-result)]
|
||||
=/ left-result
|
||||
(items-with-remainder l.a (dec q.right-result))
|
||||
[(zing ~[p.left-result ~[n.a] p.right-result]) q.left-result]
|
||||
--
|
||||
--
|
||||
14
desk/mar/contact.hoon
Normal file
14
desk/mar/contact.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
/- c=contacts
|
||||
/+ j=contacts-json
|
||||
|_ =contact:g
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun group
|
||||
++ json (contact:enjs:j contact)
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun contact:g
|
||||
--
|
||||
--
|
||||
15
desk/mar/contact/action-0.hoon
Normal file
15
desk/mar/contact/action-0.hoon
Normal file
@ -0,0 +1,15 @@
|
||||
/- c=contacts
|
||||
/+ j=contacts-json
|
||||
|_ =action:c
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun action
|
||||
++ json (action:enjs:j action)
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun action:c
|
||||
++ json action:dejs:j
|
||||
--
|
||||
--
|
||||
2
desk/mar/contact/action-1.hoon
Normal file
2
desk/mar/contact/action-1.hoon
Normal file
@ -0,0 +1,2 @@
|
||||
/= mark /mar/dummy
|
||||
mark
|
||||
2
desk/mar/contact/action.hoon
Normal file
2
desk/mar/contact/action.hoon
Normal file
@ -0,0 +1,2 @@
|
||||
/= mark /mar/contact/action-0
|
||||
mark
|
||||
14
desk/mar/contact/news.hoon
Normal file
14
desk/mar/contact/news.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
/- c=contacts
|
||||
/+ j=contacts-json
|
||||
|_ =news:c
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun news
|
||||
++ json (news:enjs:j news)
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun news:c
|
||||
--
|
||||
--
|
||||
14
desk/mar/contact/rolodex.hoon
Normal file
14
desk/mar/contact/rolodex.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
/- c=contacts
|
||||
/+ j=contacts-json
|
||||
|_ rol=rolodex:c
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun rol
|
||||
++ json (rolodex:enjs:j rol)
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun rolodex:c
|
||||
--
|
||||
--
|
||||
12
desk/mar/contact/update-0.hoon
Normal file
12
desk/mar/contact/update-0.hoon
Normal file
@ -0,0 +1,12 @@
|
||||
/- c=contacts
|
||||
|_ =update:c
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun update
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun update:c
|
||||
--
|
||||
--
|
||||
2
desk/mar/contact/update-1.hoon
Normal file
2
desk/mar/contact/update-1.hoon
Normal file
@ -0,0 +1,2 @@
|
||||
/= mark /mar/dummy
|
||||
mark
|
||||
2
desk/mar/contact/update.hoon
Normal file
2
desk/mar/contact/update.hoon
Normal file
@ -0,0 +1,2 @@
|
||||
/= mark /mar/contact/update-0
|
||||
mark
|
||||
11
desk/mar/dummy.hoon
Normal file
11
desk/mar/dummy.hoon
Normal file
@ -0,0 +1,11 @@
|
||||
|_ dum=*
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun dum
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
+$ noun *
|
||||
--
|
||||
--
|
||||
12
desk/mar/epic.hoon
Normal file
12
desk/mar/epic.hoon
Normal file
@ -0,0 +1,12 @@
|
||||
/- e=epic
|
||||
|_ =epic:e
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun epic
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun epic:e
|
||||
--
|
||||
--
|
||||
14
desk/mar/hark/action-1.hoon
Normal file
14
desk/mar/hark/action-1.hoon
Normal file
@ -0,0 +1,14 @@
|
||||
/- h=hark
|
||||
/+ j=hark-json
|
||||
|_ action=action-1:h
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun action
|
||||
--
|
||||
++ grab
|
||||
|%
|
||||
++ noun action-1:h
|
||||
++ json action-1:dejs:j
|
||||
--
|
||||
--
|
||||
@ -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
|
||||
--
|
||||
--
|
||||
|
||||
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
|
||||
--
|
||||
--
|
||||
@ -1,9 +1,7 @@
|
||||
/- g=groups, graph-store
|
||||
/- g=groups
|
||||
/- meta
|
||||
/- metadata-store
|
||||
/- cite
|
||||
/- e=epic
|
||||
/+ lib-graph=graph-store
|
||||
|%
|
||||
:: $writ: a chat message
|
||||
+$ writ [seal memo]
|
||||
@ -333,15 +331,4 @@
|
||||
readers=(set sect:g)
|
||||
writers=(set sect:g)
|
||||
==
|
||||
++ met metadata-store
|
||||
+$ club-import [ships=(set ship) =association:met =graph:gra]
|
||||
+$ club-imports (map flag club-import)
|
||||
::
|
||||
+$ import [writers=(set ship) =association:met =update-log:gra =graph:gra]
|
||||
::
|
||||
+$ imports (map flag import)
|
||||
::
|
||||
++ gra graph-store
|
||||
++ orm-gra orm:lib-graph
|
||||
++ orm-log-gra orm-log:lib-graph
|
||||
--
|
||||
|
||||
@ -1,9 +1,7 @@
|
||||
/- g=groups, graph-store
|
||||
/- g=groups
|
||||
/- meta
|
||||
/- metadata-store
|
||||
/- cite
|
||||
/- e=epic
|
||||
/+ lib-graph=graph-store
|
||||
|%
|
||||
:: $writ: a chat message
|
||||
+$ writ [seal memo]
|
||||
@ -338,15 +336,4 @@
|
||||
readers=(set sect:g)
|
||||
writers=(set sect:g)
|
||||
==
|
||||
++ met metadata-store
|
||||
+$ club-import [ships=(set ship) =association:met =graph:gra]
|
||||
+$ club-imports (map flag club-import)
|
||||
::
|
||||
+$ import [writers=(set ship) =association:met =update-log:gra =graph:gra]
|
||||
::
|
||||
+$ imports (map flag import)
|
||||
::
|
||||
++ gra graph-store
|
||||
++ orm-gra orm:lib-graph
|
||||
++ orm-log-gra orm-log:lib-graph
|
||||
--
|
||||
|
||||
@ -1,9 +1,7 @@
|
||||
/- g=groups, graph-store, uno=chat-1, zer=chat-0
|
||||
/- g=groups, uno=chat-1, zer=chat-0
|
||||
/- meta
|
||||
/- metadata-store
|
||||
/- cite
|
||||
/- e=epic
|
||||
/+ lib-graph=graph-store
|
||||
|%
|
||||
++ old
|
||||
|%
|
||||
@ -358,15 +356,4 @@
|
||||
readers=(set sect:g)
|
||||
writers=(set sect:g)
|
||||
==
|
||||
++ met metadata-store
|
||||
+$ club-import [ships=(set ship) =association:met =graph:gra]
|
||||
+$ club-imports (map flag club-import)
|
||||
::
|
||||
+$ import [writers=(set ship) =association:met =update-log:gra =graph:gra]
|
||||
::
|
||||
+$ imports (map flag import)
|
||||
::
|
||||
++ gra graph-store
|
||||
++ orm-gra orm:lib-graph
|
||||
++ orm-log-gra orm-log:lib-graph
|
||||
--
|
||||
|
||||
89
desk/sur/contacts.hoon
Normal file
89
desk/sur/contacts.hoon
Normal file
@ -0,0 +1,89 @@
|
||||
/- e=epic, g=groups
|
||||
|%
|
||||
:: [compat] protocol-versioning scheme
|
||||
::
|
||||
:: adopted from :groups, slightly modified.
|
||||
::
|
||||
:: for our action/update marks, we
|
||||
:: - *must* support our version (+okay)
|
||||
:: - *should* support previous versions (especially actions)
|
||||
:: - but *can't* support future versions
|
||||
::
|
||||
:: in the case of updates at unsupported protocol versions,
|
||||
:: we backoff and subscribe for version changes (/epic).
|
||||
:: (this alone is unlikely to help with future versions,
|
||||
:: but perhaps our peer will downgrade. in the meantime,
|
||||
:: we wait to be upgraded.)
|
||||
::
|
||||
+| %compat
|
||||
++ okay `epic`0
|
||||
++ mar
|
||||
|%
|
||||
++ base
|
||||
|%
|
||||
+$ act %contact-action
|
||||
+$ upd %contact-update
|
||||
--
|
||||
::
|
||||
++ act `mark`^~((rap 3 *act:base '-' (scot %ud okay) ~))
|
||||
++ upd `mark`^~((rap 3 *upd:base '-' (scot %ud okay) ~))
|
||||
--
|
||||
::
|
||||
+| %types
|
||||
+$ contact
|
||||
$: nickname=@t
|
||||
bio=@t
|
||||
status=@t
|
||||
color=@ux
|
||||
avatar=(unit @t)
|
||||
cover=(unit @t)
|
||||
groups=(set flag:g)
|
||||
==
|
||||
::
|
||||
+$ foreign [for=$@(~ profile) sag=$@(~ saga)]
|
||||
+$ profile [wen=@da con=$@(~ contact)]
|
||||
+$ rolodex (map ship foreign)
|
||||
::
|
||||
+$ epic epic:e
|
||||
+$ saga
|
||||
$@ $? %want :: subscribing
|
||||
%fail :: %want failed
|
||||
%lost :: epic %fail
|
||||
~ :: none intended
|
||||
==
|
||||
saga:e
|
||||
::
|
||||
+$ field
|
||||
$% [%nickname nickname=@t]
|
||||
[%bio bio=@t]
|
||||
[%status status=@t]
|
||||
[%color color=@ux]
|
||||
[%avatar avatar=(unit @t)]
|
||||
[%cover cover=(unit @t)]
|
||||
[%add-group =flag:g]
|
||||
[%del-group =flag:g]
|
||||
==
|
||||
::
|
||||
+$ action
|
||||
:: %anon: delete our profile
|
||||
:: %edit: change our profile
|
||||
:: %meet: track a peer
|
||||
:: %heed: follow a peer
|
||||
:: %drop: discard a peer
|
||||
:: %snub: unfollow a peer
|
||||
::
|
||||
$% [%anon ~]
|
||||
[%edit p=(list field)]
|
||||
[%meet p=(list ship)]
|
||||
[%heed p=(list ship)]
|
||||
[%drop p=(list ship)]
|
||||
[%snub p=(list ship)]
|
||||
==
|
||||
::
|
||||
+$ update :: network
|
||||
$% [%full profile]
|
||||
==
|
||||
::
|
||||
+$ news :: local
|
||||
[who=ship con=$@(~ contact)]
|
||||
--
|
||||
@ -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)]
|
||||
==
|
||||
--
|
||||
|
||||
117
desk/sur/hark.hoon
Normal file
117
desk/sur/hark.hoon
Normal file
@ -0,0 +1,117 @@
|
||||
/- g=groups
|
||||
|%
|
||||
:: $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
|
||||
==
|
||||
::
|
||||
:: $new-yarn: type for creating yarns
|
||||
+$ new-yarn
|
||||
$: all=?
|
||||
desk=?
|
||||
rop=rope
|
||||
con=(list content)
|
||||
wer=path
|
||||
but=(unit button)
|
||||
==
|
||||
::
|
||||
+$ 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]
|
||||
==
|
||||
::
|
||||
:: $action-1: Actions for hark pt 2
|
||||
+$ action-1
|
||||
$% [%new-yarn new-yarn]
|
||||
action
|
||||
==
|
||||
::
|
||||
+$ 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=?
|
||||
==
|
||||
--
|
||||
@ -1 +1 @@
|
||||
[%zuse 413]
|
||||
[%zuse 412]
|
||||
|
||||
@ -53,7 +53,7 @@
|
||||
?> ?=(%finished -.rep)
|
||||
?~ full-file.rep (pure:m !>(~))
|
||||
=/ body=cord q.data.u.full-file.rep
|
||||
=/ parsed=(unit json) (de-json:html body)
|
||||
=/ parsed=(unit json) (de:json:html body)
|
||||
?~ parsed (pure:m !>(~))
|
||||
?~ u.parsed (pure:m !>(~))
|
||||
=/ mined (mine-json u.parsed)
|
||||
|
||||
@ -27,7 +27,7 @@
|
||||
%- send-raw-card
|
||||
:* %pass /check-email/(scot %p ship.u.args)
|
||||
%arvo %k %fard
|
||||
%garden %hosting-email %noun
|
||||
%landscape %hosting-email %noun
|
||||
!>(`[tlon-api-key.u.args ship.u.args])
|
||||
==
|
||||
;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo
|
||||
@ -43,7 +43,7 @@
|
||||
%- send-raw-card
|
||||
:* %pass /send-mailchimp-email/(scot %p ship.u.args)
|
||||
%arvo %k %fard
|
||||
%garden %mailchimp-send-template %noun
|
||||
%landscape %mailchimp-send-template %noun
|
||||
!>(`[mandrill-api-key.u.args (trip email) "landscape-weekly-digest" (template-vars ship.u.args carpet.u.args)])
|
||||
==
|
||||
;< [wimp=wire simp=sign-arvo] bind:m take-sign-arvo
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
header-list=['Content-Type'^'application/json' ~]
|
||||
^= body
|
||||
%- some %- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
%- en:json:html
|
||||
%- pairs:enjs:format
|
||||
:~ ['key' s+(crip api-key)]
|
||||
==
|
||||
|
||||
@ -24,7 +24,7 @@
|
||||
^= body
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
%- en:json:html
|
||||
%- pairs:enjs:format
|
||||
:~ ['key' s+(crip api-key)]
|
||||
['template_name' s+(crip template-name)]
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
^= body
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
%- en:json:html
|
||||
%- pairs:enjs:format
|
||||
:~ ['key' s+(crip api-key)]
|
||||
:- 'message'
|
||||
|
||||
@ -27,7 +27,7 @@
|
||||
^= body
|
||||
%- some
|
||||
%- as-octt:mimes:html
|
||||
%- en-json:html
|
||||
%- en:json:html
|
||||
%- pairs:enjs:format
|
||||
['merge_fields' o+vars]~
|
||||
==
|
||||
|
||||
@ -25,7 +25,7 @@
|
||||
%- send-raw-card
|
||||
:* %pass /check-email/(scot %p ship.args)
|
||||
%arvo %k %fard
|
||||
%garden %hosting-email %noun
|
||||
%landscape %hosting-email %noun
|
||||
!>(`[(trip tlon-api-key.args) ship.args])
|
||||
==
|
||||
;< [mire=wire mine=sign-arvo] bind:m take-sign-arvo
|
||||
@ -41,7 +41,7 @@
|
||||
%- send-raw-card
|
||||
:* %pass /update-merge-fields/(scot %p ship.args)
|
||||
%arvo %k %fard
|
||||
%garden %mailchimp-update-merge-fields %noun
|
||||
%landscape %mailchimp-update-merge-fields %noun
|
||||
=; vars=(map @t json)
|
||||
!>(`[mailchimp.args u.mail vars])
|
||||
%- ~(gas by *(map @t json))
|
||||
|
||||
@ -1,103 +0,0 @@
|
||||
/- 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
|
||||
$: %9
|
||||
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))
|
||||
::
|
||||
++ test-half-open-capped
|
||||
=| run=@ud
|
||||
|-
|
||||
?: =(run 31)
|
||||
=+ !<(=state on-save:agent)
|
||||
(expect-eq !>(~) !>(half-open.state))
|
||||
=^ movs agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>((add-note run)))
|
||||
=^ mavs agent
|
||||
(~(on-poke agent (bowl run)) %hark-action !>(read-count))
|
||||
$(run +(run))
|
||||
::
|
||||
--
|
||||
@ -30,11 +30,11 @@ const getNoteRedirect = (path: string) => {
|
||||
return `/apps/${desk}`;
|
||||
}
|
||||
|
||||
if (path.startsWith('/grid/')) {
|
||||
if (path.startsWith('/landscape/')) {
|
||||
// Handle links to grid features (preferences, etc)
|
||||
const route = path
|
||||
.split('/')
|
||||
.filter((el) => el !== 'grid')
|
||||
.filter((el) => el !== 'landscape')
|
||||
.join('/');
|
||||
return route;
|
||||
}
|
||||
@ -68,8 +68,8 @@ const AppRoutes = () => {
|
||||
|
||||
useEffect(() => {
|
||||
const query = new URLSearchParams(search);
|
||||
if (query.has('grid-note')) {
|
||||
const redir = getNoteRedirect(query.get('grid-note')!);
|
||||
if (query.has('landscape-note')) {
|
||||
const redir = getNoteRedirect(query.get('landscape-note')!);
|
||||
navigate(redir);
|
||||
}
|
||||
}, [search]);
|
||||
@ -89,7 +89,7 @@ const AppRoutes = () => {
|
||||
|
||||
useEffect(
|
||||
handleError(() => {
|
||||
window.name = 'grid';
|
||||
window.name = 'landscape';
|
||||
|
||||
bootstrap();
|
||||
|
||||
@ -124,7 +124,7 @@ function Scheduler() {
|
||||
}
|
||||
|
||||
export function App() {
|
||||
const base = import.meta.env.MODE === 'mock' ? undefined : '/apps/grid';
|
||||
const base = import.meta.env.MODE === 'mock' ? undefined : '/apps/landscape';
|
||||
|
||||
return (
|
||||
<ErrorBoundary
|
||||
|
||||
@ -259,7 +259,7 @@ export default function Notification({ bin, groups }: NotificationProps) {
|
||||
>
|
||||
<DeskLink
|
||||
onClick={onClick}
|
||||
to={`?grid-note=${encodeURIComponent(wer || '')}`}
|
||||
to={`?landscape-note=${encodeURIComponent(wer || '')}`}
|
||||
desk={rope.desk || ''}
|
||||
className="flex flex-1 space-x-3"
|
||||
>
|
||||
|
||||
@ -55,7 +55,7 @@ function AppLinkNavigate({ desk, link }: { desk: string; link: string }) {
|
||||
}
|
||||
|
||||
const query = new URLSearchParams({
|
||||
'grid-link': encodeURIComponent(`/${link}`),
|
||||
'landscape-link': encodeURIComponent(`/${link}`),
|
||||
});
|
||||
|
||||
const url = `${getAppHref(charge.href)}?${query.toString()}`;
|
||||
|
||||
@ -36,7 +36,7 @@ export function InterfacePrefs() {
|
||||
try {
|
||||
window.navigator.registerProtocolHandler(
|
||||
'web+urbitgraph',
|
||||
'/apps/grid/perma?ext=%s',
|
||||
'/apps/landscape/perma?ext=%s',
|
||||
// @ts-expect-error ts has the wrong types for protocolhandler
|
||||
'Urbit Links'
|
||||
);
|
||||
@ -53,7 +53,7 @@ export function InterfacePrefs() {
|
||||
// @ts-expect-error ts has the wrong types for protocolhandler
|
||||
window.navigator.unregisterProtocolHandler(
|
||||
'web+urbitgraph',
|
||||
'/apps/grid/perma?ext=%s'
|
||||
'/apps/landscape/perma?ext=%s'
|
||||
);
|
||||
setProtocolHandling(false);
|
||||
} catch (e) {
|
||||
|
||||
@ -20,7 +20,7 @@ export default ({ mode }) => {
|
||||
console.log(SHIP_URL);
|
||||
|
||||
return defineConfig({
|
||||
base: mode === 'mock' ? undefined : '/apps/grid/',
|
||||
base: mode === 'mock' ? undefined : '/apps/landscape/',
|
||||
server: mode === 'mock' ? undefined : { https: true },
|
||||
build:
|
||||
mode !== 'profile'
|
||||
@ -50,7 +50,7 @@ export default ({ mode }) => {
|
||||
: [
|
||||
basicSsl(),
|
||||
urbitPlugin({
|
||||
base: 'grid',
|
||||
base: 'landscape',
|
||||
target: SHIP_URL,
|
||||
changeOrigin: true,
|
||||
secure: false,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user