urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-19 16:51:42 +03:00
Code Issues Packages Projects Releases Wiki Activity
4160ba27af
shrub/pkg/arvo/app/talk.hoon
ixv af4ad7e99d
Merge pull request #1386 from urbit/talk-read-silent 
Don't sh-note updates to a circle's read counter
2019-08-01 13:20:06 -07:00

2568 lines
69 KiB
Plaintext
Raw Blame History

:: :: ::
:::: /app/talk/hoon :: ::
:: :: ::
::
::TODO maybe keep track of received grams per circle, too?
::
::TODO [type query] => [press tab to cycle search results, newest-first]
:: => [escape to clear]
::
:: This client implementation makes use of the %inbox
:: for all its subscriptions and messaging. All
:: rumors received are exclusively about the %inbox,
:: since that's the only thing the client ever
:: subscribes to.
::
/- sole-sur=sole :: structures
/+ *hall, sole-lib=sole :: libraries
/= seed /~ !>(.)
::
::::
::
=> :: #
:: # %arch
:: #
:: data structures
::
|%
++ state :: application state
$: :: messaging state ::
grams/(list telegram) :: all history
known/(map serial @ud) :: messages heard
last/@ud :: last heard
count/@ud :: (lent grams)
sources/(set circle) :: our subscriptions
:: circle details ::
remotes/(map circle group) :: remote presences
mirrors/(map circle config) :: remote configs
:: ui state ::
nicks/(map ship nick) :: human identities
bound/(map audience char) :: bound circle glyphs
binds/(jug char audience) :: circle glyph lookup
cli/shell :: interaction state
== ::
++ shell :: console session
$: id/bone :: identifier
latest/@ud :: latest shown msg num
say/sole-share:sole-sur :: console state
active/audience :: active targets
settings/(set term) :: frontend settings
width/@ud :: display width
timez/(pair ? @ud) :: timezone adjustment
== ::
++ move (pair bone card) :: all actions
++ lime :: diff fruit
$% {$sole-effect sole-effect:sole-sur} ::
== ::
++ pear :: poke fruit
$% {$hall-command command} ::
{$hall-action action} ::
== ::
++ card :: general card
$% {$diff lime} ::
{$poke wire dock pear} ::
{$peer wire dock path} ::
{$pull wire dock ~} ::
== ::
++ work :: interface action
$% :: circle management ::
{$join (map circle range) (unit char)} :: subscribe to
{$leave audience} :: unsubscribe from
{$create security name cord (unit char)} :: create circle
{$delete name (unit cord)} :: delete circle
{$depict name cord} :: change description
{$filter name ? ?} :: change message rules
{$invite name (set ship)} :: give permission
{$banish name (set ship)} :: deny permission
{$source name (map circle range)} :: add source
{$unsource name (map circle range)} :: remove source
{$read name @ud} :: set read count
:: personal metadata ::
{$attend audience (unit presence)} :: set our presence
{$name audience human} :: set our name
:: messaging ::
{$say (list speech)} :: send message
{$eval cord hoon} :: send #-message
{$target p/audience q/(unit work)} :: set active targets
{$reply $@(@ud {@u @ud}) (list speech)} :: reply to
:: displaying info ::
{$number $@(@ud {@u @ud})} :: relative/absolute
{$who audience} :: presence
{$what (unit $@(char audience))} :: show bound glyph
{$circles ~} :: show our circles
{$sources circle} :: show active sources
:: ui settings ::
{$bind char (unit audience)} :: bind glyph
{$unbind char (unit audience)} :: unbind glyph
{$nick (unit ship) (unit cord)} :: un/set/show nick
{$set term} :: enable setting
{$unset term} :: disable setting
{$width @ud} :: change display width
{$timez ? @ud} :: adjust shown times
:: miscellaneous ::
{$show circle} :: show membership
{$hide circle} :: hide membership
{$help ~} :: print usage info
== ::
++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] :: circle char pool '
--
::
:: #
:: # %work
:: #
:: functional cores and arms.
::
|_ {bol/bowl:gall $1 state}
::
:: # %transition
:: prep transition
+| %transition
::
++ prep
:: adapts state
::
=> |%
++ states
$%({$1 s/state} {$0 s/state-0})
::
++ state-0
(cork state |=(a/state a(mirrors (~(run by mirrors.a) config-0))))
++ config-0
{src/(set source-0) cap/cord tag/tags fit/filter con/control}
++ source-0
{cir/circle ran/range-0}
++ range-0
%- unit
$: hed/place-0
tal/(unit place-0)
==
++ place-0
$% {$da @da}
{$ud @ud}
{$sd @sd}
==
--
=| mos/(list move)
|= old/(unit states)
^- (quip move _..prep)
?~ old
ta-done:ta-init:ta
?- -.u.old
$1
[mos ..prep(+<+ u.old)]
::
$0
=. mos [[ost.bol %pull /server/inbox server ~] peer-inbox mos]
=- $(old `[%1 s.u.old(mirrors -)])
|^
(~(run by mirrors.s.u.old) prep-config)
::
++ prep-config
|= cof/config-0
^- config
=. src.cof
%- ~(gas in *(set source))
(murn ~(tap in src.cof) prep-source)
:* src.cof
cap.cof
tag.cof
fit.cof
con.cof
0
==
::
++ prep-source
|= src/source-0
^- (unit source)
=+ nan=(prep-range ran.src)
?~ nan
~& [%forgetting-source src]
~
`src(ran u.nan)
::
++ prep-range
|= ran/range-0
^- (unit range)
?~ ran `ran
:: ranges with a relative end aren't stored because they end
:: immediately, so if we find one we can safely discard it.
?: ?=({$~ {$sd @sd}} tal.u.ran) ~
:: we replace relative range starts with the current date.
:: this is practically correct.
?: ?=({$sd @sd} hed.u.ran)
`ran(hed.u [%da now.bol])
`ran
--
==
::
:: #
:: # %utility
:: #
:: small utility functions.
+| %utility
::
++ self
(true-self [our now our]:bol)
::
++ server
:: our hall instance
^- dock
[self %hall]
::
++ inbox
:: client's circle name
::
:: produces the name of the circle used by this
:: client for all its operations
^- name
%inbox
::
++ incir
:: client's circle
::
:: ++inbox, except a full circle.
^- circle
[self inbox]
::
++ renum
:: find the grams list index for gram with serial.
|= ser/serial
^- (unit @ud)
=+ num=(~(get by known) ser)
?~ num ~
`(sub count +(u.num))
::
++ recall
:: find a known gram with serial {ser}.
|= ser/serial
^- (unit telegram)
=+ num=(renum ser)
?~ num ~
`(snag u.num grams)
::
++ bound-from-binds
:: bound from binds
::
:: using a mapping of character to audiences, create
:: a mapping of audience to character.
::
|: bin=binds
^+ bound
%- ~(gas by *(map audience char))
=- (zing -)
%+ turn ~(tap by bin)
|= {a/char b/(set audience)}
(turn ~(tap by b) |=(c/audience [c a]))
::
++ glyph
:: finds a new glyph for assignment.
::
|= idx/@
=< cha
%+ reel glyphs
|= {all/tape ole/{cha/char num/@}}
=+ new=(snag (mod idx (lent all)) all)
=+ num=~(wyt in (~(get ju binds) new))
?~ cha.ole [new num]
?: (lth num.ole num)
ole
[new num]
::
++ peer-client
:: ui state peer move
^- move
:* ost.bol
%peer
/server/client
server
/client
==
::
++ peer-inbox
^- move
:* ost.bol
%peer
/server/inbox
server
::
%+ welp /circle/[inbox]/grams/config/group
?. =(0 count)
[(scot %ud last) ~]
=+ history-msgs=200
[(cat 3 '-' (scot %ud history-msgs)) ~]
==
::
:: #
:: # %engines
:: #
:: main cores.
+| %engines
::
++ ta
:: per transaction
::
:: for every transaction/event (poke, peer etc.)
:: talk receives, the ++ta transaction core is
:: called.
:: in processing transactions, ++ta may modify app
:: state, or create moves. these moves get produced
:: upon finalizing the core's with with ++ta-done.
:: when making changes to the shell, the ++sh core is
:: used.
::
|_ :: moves: moves created by core operations.
::
moves/(list move)
::
:: # %resolve
+| %resolve
::
++ ta-done
:: resolve core
::
:: produces the moves stored in ++ta's moves.
:: %sole-effect moves get squashed into a %mor.
::
^+ [*(list move) +>]
:_ +>
:: seperate our sole-effects from other moves.
=/ yop
|- ^- (pair (list move) (list sole-effect:sole-sur))
?~ moves [~ ~]
=+ mor=$(moves t.moves)
?: ?& =(id.cli p.i.moves)
?=({$diff $sole-effect *} q.i.moves)
==
[p.mor [+>.q.i.moves q.mor]]
[[i.moves p.mor] q.mor]
:: flop moves, flop and squash sole-effects into a %mor.
=+ moz=(flop p.yop)
=/ foc/(unit sole-effect:sole-sur)
?~ q.yop ~
?~ t.q.yop `i.q.yop :: single sole-effect
`[%mor (flop q.yop)] :: more sole-effects
:: produce moves or sole-effects and moves.
?~ foc moz
?~ id.cli ~&(%client-no-sole moz)
[[id.cli %diff %sole-effect u.foc] moz]
::
:: #
:: # %emitters
:: #
:: arms that create outward changes.
+| %emitters
::
++ ta-emil
:: emit move list
::
:: adds multiple moves to the core's list.
:: flops to emulate ++ta-emit.
::
|= mol/(list move)
%_(+> moves (welp (flop mol) moves))
::
++ ta-emit
:: adds a move to the core's list.
::
|= mov/move
%_(+> moves [mov moves])
::
:: #
:: # %interaction-events
:: #
:: arms that apply events we received.
+| %interaction-events
::
++ ta-init
:: subscribes to our hall.
::
%- ta-emil
^- (list move)
~[peer-client peer-inbox]
::
++ ta-take
:: accept prize
::
|= piz/prize
^+ +>
?+ -.piz +>
$client
%= +>
binds gys.piz
bound (bound-from-binds gys.piz)
nicks nis.piz
==
::
$circle
%. nes.piz
%= ta-unpack
sources (~(run in src.loc.cos.piz) head)
mirrors (~(put by rem.cos.piz) incir loc.cos.piz)
remotes (~(put by rem.pes.piz) incir loc.pes.piz)
==
==
::
++ ta-hear
:: apply change
::
|= rum/rumor
^+ +>
?+ -.rum +>
$client
?- -.rum.rum
$glyph
(ta-change-glyph +.rum.rum)
::
$nick
+>(nicks (change-nicks nicks who.rum.rum nic.rum.rum))
==
::
$circle
(ta-change-circle rum.rum)
==
::
++ ta-change-circle
:: apply circle change
::
|= rum/rumor-story
^+ +>
?+ -.rum
~&([%unexpected-circle-rumor -.rum] +>)
::
$gram
(ta-open nev.rum)
::
$config
=+ cur=(~(gut by mirrors) cir.rum *config)
=. +>.$
=< sh-done
%- ~(sh-show-config sh cli)
[cir.rum cur dif.rum]
=? +>.$
?& ?=($source -.dif.rum)
add.dif.rum
=(cir.rum incir)
==
=* cir cir.src.dif.rum
=+ ren=~(cr-phat cr cir)
=+ gyf=(~(get by bound) [cir ~ ~])
=< sh-done
=/ sho
:: only present if we're here indefinitely.
=* ran ran.src.dif.rum
?. |(?=(~ ran) ?=(~ tal.u.ran))
~(. sh cli)
%- ~(sh-act sh cli)
[%notify [cir ~ ~] `%hear]
?^ gyf
(sh-note:sho "has glyph {[u.gyf ~]} for {ren}")
:: we use the rendered circle name to determine
:: the glyph for higher glyph consistency when
:: federating.
=+ cha=(glyph (mug ren))
(sh-work:sho %bind cha `[cir ~ ~])
%= +>.$
sources
?. &(?=($source -.dif.rum) =(cir.rum incir))
sources
%. cir.src.dif.rum
?: add.dif.rum
~(put in sources)
~(del in sources)
::
mirrors
?: ?=($remove -.dif.rum) (~(del by mirrors) cir.rum)
%+ ~(put by mirrors) cir.rum
(change-config cur dif.rum)
==
::
$status
=+ rem=(~(gut by remotes) cir.rum *group)
=+ cur=(~(gut by rem) who.rum *status)
=. +>.$
=< sh-done
%- ~(sh-show-status sh cli)
[cir.rum who.rum cur dif.rum]
%= +>.$
remotes
%+ ~(put by remotes) cir.rum
?: ?=($remove -.dif.rum) (~(del by rem) who.rum)
%+ ~(put by rem) who.rum
(change-status cur dif.rum)
==
==
::
++ ta-change-glyph
:: applies new set of glyph bindings.
::
|= {bin/? gyf/char aud/audience}
^+ +>
=+ nek=(change-glyphs binds bin gyf aud)
?: =(nek binds) +>.$ :: no change
=. binds nek
=. bound (bound-from-binds nek)
sh-done:~(sh-prod sh cli)
::
:: #
:: # %messages
:: #
:: storing and updating messages.
+| %messages
::
++ ta-unpack
:: open envelopes
::
:: the client currently doesn't care about nums.
::
|= nes/(list envelope)
^+ +>
?~ nes +>
$(nes t.nes, +> (ta-open i.nes))
::
++ ta-open
:: learn message from an envelope.
::
|= nev/envelope
^+ +>
=? last (gth num.nev last) num.nev
(ta-learn gam.nev)
::
++ ta-learn
:: save/update message
::
:: store an incoming telegram, updating if it
:: already exists.
::
|= gam/telegram
^+ +>
=+ old=(renum uid.gam)
?~ old
(ta-append gam) :: add
(ta-revise u.old gam) :: modify
::
++ ta-append
:: store a new telegram.
::
|= gam/telegram
^+ +>
=: grams [gam grams]
count +(count)
known (~(put by known) uid.gam count)
==
=< sh-done
(~(sh-gram sh cli) gam)
::
++ ta-revise
:: modify a telegram we know.
::
|= {num/@ud gam/telegram}
=+ old=(snag num grams)
?: =(gam old) +>.$ :: no change
=. grams
%+ welp
(scag num grams)
[gam (slag +(num) grams)]
?: =(sep.gam sep.old) +>.$ :: no worthy change
=< sh-done
(~(sh-gram sh cli) gam)
::
:: #
:: # %console
:: #
:: arms for shell functionality.
+| %console
::
++ ta-console
:: initialize the shell of this client.
::
^+ .
=| she/shell
=. id.she ost.bol
:: XXX: +sy should be smarter than this
=/ circle-list=(list circle) [incir ~]
=. active.she (sy circle-list)
=. width.she 80
sh-done:~(sh-prod sh she)
::
++ ta-sole
:: apply sole input
::
|= act/sole-action:sole-sur
^+ +>
?. =(id.cli ost.bol)
~&(%strange-sole !!)
sh-done:(~(sh-sole sh cli) act)
::
++ sh
:: per console
::
:: shell core, responsible for handling user input
:: and the related actions, and outputting changes
:: to the cli.
::
|_ $: :: she: console state.
::
she/shell
==
::
:: # %resolve
+| %resolve
::
++ sh-done
:: stores changes to the cli.
::
^+ +>
+>(cli she)
::
:: #
:: # %emitters
:: #
:: arms that create outward changes.
+| %emitters
::
++ sh-fact
:: adds a console effect to ++ta's moves.
::
|= fec/sole-effect:sole-sur
^+ +>
+>(moves [[id.she %diff %sole-effect fec] moves])
::
++ sh-act
:: adds an action to ++ta's moves.
::
|= act/action
^+ +>
%= +>
moves
:_ moves
:* ost.bol
%poke
/client/action
server
[%hall-action act]
==
==
::
:: #
:: # %cli-interaction
:: #
:: processing user input as it happens.
+| %cli-interaction
::
++ sh-sole
:: applies sole action.
::
|= act/sole-action:sole-sur
^+ +>
?- -.act
$det (sh-edit +.act)
$clr ..sh-sole :: (sh-pact ~) :: XX clear to PM-to-self?
$ret sh-obey
==
::
++ sh-edit
:: apply sole edit
::
:: called when typing into the cli prompt.
:: applies the change and does sanitizing.
::
|= cal/sole-change:sole-sur
^+ +>
=^ inv say.she (~(transceive sole-lib say.she) cal)
=+ fix=(sh-sane inv buf.say.she)
?~ lit.fix
+>.$
:: just capital correction
?~ err.fix
(sh-slug fix)
:: allow interior edits and deletes
?. &(?=($del -.inv) =(+(p.inv) (lent buf.say.she)))
+>.$
(sh-slug fix)
::
++ sh-read
:: command parser
::
:: parses the command line buffer. produces work
:: items which can be executed by ++sh-work.
::
=< work
:: # %parsers
:: various parsers for command line input.
|%
++ expr
:: [cord hoon]
|= tub/nail %. tub
%+ stag (crip q.tub)
wide:(vang & [&1:% &2:% (scot %da now.bol) |3:%])
::
++ dare
:: @dr
%+ sear
|= a/coin
?. ?=({$$ $dr @} a) ~
(some `@dr`+>.a)
nuck:so
::
++ ship ;~(pfix sig fed:ag) :: ship
++ shiz :: ship set
%+ cook
|=(a/(list ^ship) (~(gas in *(set ^ship)) a))
(most ;~(plug com (star ace)) ship)
::
++ cire :: local circle
;~(pfix cen urs:ab)
::
++ circ :: circle
;~ pose
(cold incir col)
;~(pfix cen (stag self urs:ab))
;~(pfix net (stag (^sein:title self) urs:ab))
::
%+ cook
|= {a/@p b/(unit term)}
[a ?^(b u.b %inbox)]
;~ plug
ship
(punt ;~(pfix net urs:ab))
==
==
::
++ circles-flat :: collapse mixed list
|= a/(list (each circle (set circle)))
^- (set circle)
?~ a ~
?- -.i.a
%& (~(put in $(a t.a)) p.i.a)
%| (~(uni in $(a t.a)) p.i.a)
==
::
++ cirs :: non-empty circles
%+ cook circles-flat
%+ most ;~(plug com (star ace))
(^pick circ (sear sh-glyf glyph))
::
++ drat
:: @da or @dr
::
:: pas: whether @dr's are in the past or not.
|= pas/?
=- ;~(pfix sig (sear - crub:so))
|= a/^dime
^- (unit @da)
?+ p.a ~
$da `q.a
$dr :- ~
%. [now.bol q.a]
?:(pas sub add)
==
::
++ pont :: point for range
:: hed: whether this is the head or tail point.
|= hed/?
;~ pose
(cold [%da now.bol] (jest 'now'))
(stag %da (drat hed))
placer
==
::
++ rang :: subscription range
=+ ;~ pose
(cook some ;~(pfix net (pont |)))
(easy ~)
==
;~ pose
(cook some ;~(plug ;~(pfix net (pont &)) -))
(easy ~)
==
::
++ sorz :: non-empty sources
%+ cook ~(gas by *(map circle range))
(most ;~(plug com (star ace)) ;~(plug circ rang))
::
++ pick :: message reference
;~(pose nump (cook lent (star mic)))
::
++ nump :: number reference
;~ pose
;~(pfix hep dem:ag)
;~ plug
(cook lent (plus (just '0')))
;~(pose dem:ag (easy 0))
==
(stag 0 dem:ag)
==
::
++ pore :: security
(perk %channel %village %journal %mailbox ~)
::
++ lobe :: y/n loob
;~ pose
(cold %& ;~(pose (jest 'y') (jest '&') (just 'true')))
(cold %| ;~(pose (jest 'n') (jest '|') (just 'false')))
==
::
++ message :: exp, lin or url msg
;~ pose
;~(plug (cold %eval hax) expr)
(stag %say speeches)
==
::
++ speeches :: lin or url msgs
%+ most (jest '•')
;~ pose
(stag %url aurf:de-purl:html)
:(stag %lin & ;~(pfix vat text))
:(stag %lin | ;~(less mic hax text))
==
::
++ text :: msg without break
%+ cook crip
(plus ;~(less (jest '•') next))
::
++ nick (cook crip (plus next)) :: nickname
++ glyph (mask "/\\\{(<!?{(zing glyphs)}") :: circle postfix
++ setting :: setting flag
%- perk :~
%nicks
%quiet
%notify
%showtime
==
++ work :: full input
%+ knee *^work |. ~+
=- ;~(pose ;~(pfix mic -) message)
;~ pose
::
:: circle management
::
;~((glue ace) (perk %read ~) cire dem:ag)
::
;~((glue ace) (perk %join ~) ;~(plug sorz (punt ;~(pfix ace glyph))))
::
;~((glue ace) (perk %leave ~) cirs)
::
;~ (glue ace) (perk %create ~)
pore
cire
;~(plug qut (punt ;~(pfix ace glyph)))
==
::
;~ plug (perk %delete ~)
;~(pfix ace cire)
;~ pose
(cook some ;~(pfix ace qut))
(easy ~)
==
==
::
;~((glue ace) (perk %depict ~) cire qut)
::
;~((glue ace) (perk %filter ~) cire lobe lobe)
::
;~((glue ace) (perk %invite ~) cire shiz)
::
;~((glue ace) (perk %banish ~) cire shiz)
::
;~((glue ace) (perk %source ~) cire sorz)
::
;~((glue ace) (perk %unsource ~) cire sorz)
::TODO why do these nest-fail when doing perk with multiple?
::
:: personal metadata
::
;~ (glue ace)
(perk %attend ~)
cirs
;~ pose
(cold ~ sig)
(cook some (perk %gone %idle %hear %talk ~))
==
==
::
;~ plug
(perk %name ~)
;~(pfix ace cirs)
;~(pfix ace ;~(pose (cook some qut) (cold ~ sig)))
;~ pose
;~ pfix ace
%+ cook some
;~ pose
;~((glue ace) qut (cook some qut) qut)
;~(plug qut (cold ~ ace) qut)
==
==
;~(pfix ace (cold ~ sig))
(easy ~)
==
==
::
:: displaying info
::
;~(plug (perk %who ~) ;~(pose ;~(pfix ace cirs) (easy ~)))
::
;~ plug
(perk %what ~)
;~ pose
;~(pfix ace (cook some ;~(pose glyph cirs)))
(easy ~)
==
==
::
;~(plug (perk %circles ~) (easy ~))
::
;~((glue ace) (perk %sources ~) circ)
::
;~((glue ace) (perk %show ~) circ)
::
;~((glue ace) (perk %hide ~) circ)
::
:: ui settings
::
;~(plug (perk %bind ~) ;~(pfix ace glyph) (punt ;~(pfix ace cirs)))
::
;~(plug (perk %unbind ~) ;~(pfix ace glyph) (punt ;~(pfix ace cirs)))
::
;~ plug (perk %nick ~)
;~ pose
;~ plug
(cook some ;~(pfix ace ship))
(cold (some '') ;~(pfix ace sig))
==
;~ plug
;~ pose
(cook some ;~(pfix ace ship))
(easy ~)
==
;~ pose
(cook some ;~(pfix ace nick))
(easy ~)
==
==
==
==
::
;~(plug (cold %width (jest 'set width ')) dem:ag)
::
;~ plug
(cold %timez (jest 'set timezone '))
::
;~ pose
(cold %| (just '-'))
(cold %& (just '+'))
==
::
%+ sear
|= a/@ud
^- (unit @ud)
?: &((gte a 0) (lte a 14))
`a ~
dem:ag
==
::
;~(plug (perk %set ~) ;~(pose ;~(pfix ace setting) (easy %$)))
::
;~(plug (perk %unset ~) ;~(pfix ace setting))
::
:: miscellaneous
::
;~(plug (perk %help ~) (easy ~))
::
:: (parsers below come last because they match quickly)
::
:: messaging
::
(stag %target ;~(plug cirs (punt ;~(pfix ace message))))
::
(stag %reply ;~(plug pick ;~(pfix ace speeches)))
::
:: displaying info
::
(stag %number pick)
==
--
::
++ sh-sane
:: sanitize input
::
:: parses cli prompt input using ++sh-read and
:: sanitizes when invalid.
::
|= {inv/sole-edit:sole-sur buf/(list @c)}
^- {lit/(list sole-edit:sole-sur) err/(unit @u)}
=+ res=(rose (tufa buf) sh-read)
?: ?=(%| -.res) [[inv]~ `p.res]
:_ ~
?~ p.res ~
=+ wok=u.p.res
|- ^- (list sole-edit:sole-sur)
?+ -.wok
~
::
$target
?~(q.wok ~ $(wok u.q.wok))
==
::
++ sh-slug
:: corrects invalid prompt input.
::
|= {lit/(list sole-edit:sole-sur) err/(unit @u)}
^+ +>
?~ lit +>
=^ lic say.she
(~(transmit sole-lib say.she) `sole-edit:sole-sur`?~(t.lit i.lit [%mor lit]))
(sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)])
::
++ sh-obey
:: apply result
::
:: called upon hitting return in the prompt. if
:: input is invalid, ++sh-slug is called.
:: otherwise, the appropriate work is done and
:: the entered command (if any) gets displayed
:: to the user.
::
=+ fix=(sh-sane [%nop ~] buf.say.she)
?^ lit.fix
(sh-slug fix)
=+ jub=(rust (tufa buf.say.she) sh-read)
?~ jub (sh-fact %bel ~)
%. u.jub
=< sh-work
=+ buf=buf.say.she
=? ..sh-obey &(?=({$';' *} buf) !?=($reply -.u.jub))
(sh-note (tufa `(list @)`buf))
=^ cal say.she (~(transmit sole-lib say.she) [%set ~])
%+ sh-fact %mor
:~ [%nex ~]
[%det cal]
==
::
:: #
:: # %user-action
:: #
:: processing user actions.
+| %user-action
::
++ sh-work
:: do work
::
:: implements worker arms for different talk
:: commands.
:: worker arms must produce updated state.
::
|= job/work
^+ +>
=< work
|%
::
:: #
:: # %helpers
:: #
+| %helpers
::
++ work
:: call correct worker
?- -.job
:: circle management
$join (join +.job)
$leave (leave +.job)
$create (create +.job)
$delete (delete +.job)
$depict (depict +.job)
$filter (filter +.job)
$invite (permit & +.job)
$banish (permit | +.job)
$source (source & +.job)
$unsource (source | +.job)
$read (read +.job)
:: personal metadata
$attend (attend +.job)
$name (set-name +.job)
:: messaging
$say (say +.job)
$eval (eval +.job)
$target (target +.job)
$reply (reply +.job)
:: displaying info
$number (number +.job)
$who (who +.job)
$what (what +.job)
$circles circles
$sources (list-sources +.job)
:: ui settings
$bind (bind +.job)
$unbind (unbind +.job)
$nick (nick +.job)
$set (wo-set +.job)
$unset (unset +.job)
$width (width +.job)
$timez (timez +.job)
:: miscelaneous
$show (public & +.job)
$hide (public | +.job)
$help help
==
::
++ activate
:: prints message details.
::
|= gam/telegram
^+ ..sh-work
=+ tay=~(. tr settings.she gam)
=. ..sh-work (sh-fact tr-fact:tay)
sh-prod(active.she aud.gam)
::
++ deli
:: gets absolute message number from relative.
::
|= {max/@ud nul/@u fin/@ud}
^- @ud
=+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10)))))
=. dog (mul dog (pow 10 nul))
=- ?:((lte - max) - (sub - dog))
(add fin (sub max (mod max dog)))
::
++ set-glyph
:: new glyph binding
::
:: applies glyph binding to our state and sends
:: an action.
::
|= {cha/char aud/audience}
=: bound (~(put by bound) aud cha)
binds (~(put ju binds) cha aud)
==
sh-prod:(sh-act %glyph cha aud &)
::
++ unset-glyph
:: remote old glyph binding
::
:: removes either {aud} or all bindings on a
:: glyph and sends an action.
::
|= {cha/char aud/(unit audience)}
=/ ole/(set audience)
?^ aud [u.aud ~ ~]
(~(get ju binds) cha)
=. ..sh-work (sh-act %glyph cha (fall aud ~) |)
|- ^+ ..sh-work
?~ ole ..sh-work
=. ..sh-work $(ole l.ole)
=. ..sh-work $(ole r.ole)
%= ..sh-work
bound (~(del by bound) n.ole)
binds (~(del ju binds) cha n.ole)
==
::
++ reverse-nicks
:: finds all ships whose handle matches {nym}.
::
|= nym/^nick
^- (list ship)
%+ murn ~(tap by nicks)
|= {p/ship q/^nick}
?. =(q nym) ~
[~ u=p]
::
++ hoon-head
:: eval data
::
:: makes a vase of environment data to evaluate
:: against (for #-messages).
::
^- vase
!> ^- {our/@p now/@da eny/@uvI}
[self now.bol (shas %eny eny.bol)]
::
:: #
:: # %circle-management
:: #
+| %circle-management
::
++ join
:: %join
::
:: change local mailbox config to include
:: subscriptions to {pas}.
::
|= {pos/(map circle range) gyf/(unit char)}
^+ ..sh-work
=+ pas=~(key by pos)
=? ..sh-work ?=(^ gyf)
(bind u.gyf `pas)
=. ..sh-work
sh-prod(active.she pas)
:: default to a day of backlog
=. pos
%- ~(run by pos)
|= r/range
?~(r `[da+(sub now.bol ~d1) ~] r)
(sh-act %source inbox & pos)
::
++ leave
:: %leave
::
:: change local mailbox config to exclude
:: subscriptions to {pas}.
::
|= pas/(set circle)
^+ ..sh-work
:: remove *all* sources relating to {pas}.
=/ pos
%- ~(gas in *(set ^source))
%- zing
=/ sos
=- ~(tap in src:-)
(~(gut by mirrors) incir *config)
%+ turn ~(tap in pas)
|= c/circle
%+ skim sos
|=(s/^source =(cir.s c))
=. ..sh-work
(sh-act %source inbox | pos)
(sh-act %notify pas ~)
::
++ create
:: %create
::
:: creates circle {nom} with specified config.
::
|= {sec/security nom/name txt/cord gyf/(unit char)}
^+ ..sh-work
=. ..sh-work
(sh-act %create nom txt sec)
(join [[[self nom] ~] ~ ~] gyf)
::
++ delete
:: %delete
::
:: deletes our circle {nom}, after optionally
:: sending a last announce message {say}.
::
|= {nom/name say/(unit cord)}
^+ ..sh-work
(sh-act %delete nom say)
::
++ depict
:: %depict
::
:: changes the description of {nom} to {txt}.
::
|= {nom/name txt/cord}
^+ ..sh-work
(sh-act %depict nom txt)
::
++ permit
:: %invite / %banish
::
:: invites or banishes {sis} to/from our
:: circle {nom}.
::
|= {inv/? nom/name sis/(set ship)}
^+ ..sh-work
=. ..sh-work (sh-act %permit nom inv sis)
=- (sh-act %phrase - [%inv inv [self nom]]~)
%- ~(rep in sis)
|= {s/ship a/audience}
(~(put in a) [s %i])
::
++ filter
|= {nom/name cus/? utf/?}
^+ ..sh-work
(sh-act %filter nom cus utf)
::
++ source
:: %source
::
:: adds {pas} to {nom}'s src.
::
|= {sub/? nom/name pos/(map circle range)}
^+ ..sh-work
(sh-act %source nom sub pos)
::
++ read
:: %read
::
:: set {red} for {nom}
::
|= {nom/name red/@ud}
^+ ..sh-work
(sh-act %read nom red)
::
:: #
:: # %personal-metadata
:: #
+| %personal-metadata
::
++ attend
:: sets our presence to {pec} for {aud}.
::
|= {aud/audience pec/(unit presence)}
^+ ..sh-work
(sh-act %notify aud pec)
::
++ set-name
:: sets our name to {man} for {aud}.
::
|= {aud/audience man/human}
^+ ..sh-work
(sh-act %naming aud man)
::
:: #
:: # %messaging
:: #
+| %messaging
::
++ say
:: sends message.
::
|= sep/(list speech)
^+ ..sh-work
(sh-act %phrase active.she sep)
::
++ eval
:: run
::
:: executes {exe} and sends both its code and
:: result.
::
|= {txt/cord exe/hoon}
=> |.([(sell (slap (slop hoon-head seed) exe))]~)
=+ tan=p:(mule .)
(say [%exp txt tan] ~)
::
++ target
:: %target
::
:: sets messaging target, then execute {woe}.
::
|= {aud/audience woe/(unit ^work)}
^+ ..sh-work
=. ..sh-pact (sh-pact aud)
?~(woe ..sh-work work(job u.woe))
::
++ reply
:: %reply
::
:: send a reply to the selected message.
::
|= {num/$@(@ud {p/@u q/@ud}) sep/(list speech)}
^+ ..sh-work
:: =- (say (turn ... [%ire - s])) nest-fails on the - ???
::TODO what's friendlier, reply-to-null or error?
=/ ser/serial
?@ num
?: (gte num count) 0v0
uid:(snag num grams)
?: (gth q.num count) 0v0
?: =(count 0) 0v0
=+ msg=(deli (dec count) num)
uid:(snag (sub count +(msg)) grams)
(say (turn sep |=(s/speech [%ire ser s])))
::
:: #
:: # %displaying-info
:: #
+| %displaying-info
::
++ who
:: %who
::
:: prints presence lists for {cis} or all.
::
|= cis/(set circle) ^+ ..sh-work
=< (sh-fact %mor (murn (sort ~(tap by remotes) aor) .))
|= {cir/circle gop/group} ^- (unit sole-effect:sole-sur)
?. |(=(~ cis) (~(has in cis) cir)) ~
?: =(%mailbox sec.con:(~(gut by mirrors) cir *config)) ~
?. (~(has in sources) cir) ~
=- `[%tan rose+[", " `~]^- leaf+~(cr-full cr cir) ~]
=< (murn (sort ~(tap by gop) aor) .)
|= {a/ship b/presence c/human} ^- (unit tank)
=? c =(han.c `(scot %p a)) [~ tru.c]
?- b
$gone ~
$idle `leaf+:(weld "idle " (scow %p a) " " (trip (fall han.c '')))
$hear `leaf+:(weld "hear " (scow %p a) " " (trip (fall han.c '')))
$talk `leaf+:(weld "talk " (scow %p a) " " (trip (fall han.c '')))
==
::
++ what
:: %what
::
:: prints binding details. goes both ways.
::
:: XX this type is a misjunction, audience can be ~
::
|= qur/(unit $@(char audience))
^+ ..sh-work
?^ qur
?^ u.qur
=+ cha=(~(get by bound) u.qur)
(sh-fact %txt ?~(cha "none" [u.cha]~))
=+ pan=~(tap in (~(get ju binds) `@t`u.qur))
?: =(~ pan) (sh-fact %txt "~")
=< (sh-fact %mor (turn pan .))
|=(a/audience [%txt ~(ar-phat ar a)])
%+ sh-fact %mor
%- ~(rep by binds)
|= $: {gyf/char aus/(set audience)}
lis/(list sole-effect:sole-sur)
==
%+ weld lis
^- (list sole-effect:sole-sur)
%- ~(rep in aus)
|= {a/audience l/(list sole-effect:sole-sur)}
%+ weld l
^- (list sole-effect:sole-sur)
[%txt [gyf ' ' ~(ar-phat ar a)]]~
::
++ number
:: %number
::
:: finds selected message, expand it.
::
|= num/$@(@ud {p/@u q/@ud})
^+ ..sh-work
|-
?@ num
?: (gte num count)
(sh-lame "{(scow %s (new:si | +(num)))}: no such telegram")
=. ..sh-fact (sh-fact %txt "? {(scow %s (new:si | +(num)))}")
(activate (snag num grams))
?. (gte q.num count)
?: =(count 0)
(sh-lame "0: no messages")
=+ msg=(deli (dec count) num)
=. ..sh-fact (sh-fact %txt "? {(scow %ud msg)}")
(activate (snag (sub count +(msg)) grams))
(sh-lame "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram")
::
++ circles
:: %circles
::
:: list all local circles.
::
^+ ..sh-work
=/ piz
=- .^(prize %gx -)
%+ weld /(scot %p our.bol)/hall/(scot %da now.bol)
/circles/(scot %p our.bol)/hall-prize
?> ?=($circles -.piz)
%+ sh-fact %mor
%+ turn (sort ~(tap in cis.piz) lth)
|= a/name [%txt "%{(trip a)}"]
::
++ list-sources
:: %sources
::
:: display the active sources for our circle.
::
|= cir/circle
^+ ..sh-work
%+ sh-fact %mor
%+ turn
:: make sure to exclude {nom} itself.
=- ~(tap in (~(del in src:-) [cir ~]))
(~(gut by mirrors) cir *config)
|= s/^source
^- sole-effect:sole-sur
:- %txt
%+ weld ~(cr-phat cr cir.s)
%+ roll (range-to-path ran.s)
|= {a/@ta b/tape}
:(weld b "/" (trip a))
::
:: #
:: # %ui-settings
:: #
+| %ui-settings
::
++ bind
:: %bind
::
:: binds targets {aud} to the glyph {cha}.
::
|= {cha/char aud/(unit audience)}
^+ ..sh-work
?~ aud $(aud `active.she)
=+ ole=(~(get by bound) u.aud)
?: =(ole [~ cha]) ..sh-work
%. "bound {<cha>} {<u.aud>}"
sh-note:sh-prod:(set-glyph cha u.aud)
::
++ unbind
:: %unbind
::
:: unbinds targets {aud} to glyph {cha}.
::
|= {cha/char aud/(unit audience)}
^+ ..sh-work
?. ?| &(?=(^ aud) (~(has by bound) u.aud))
&(?=(~ aud) (~(has by binds) cha))
==
..sh-work
%. "unbound {<cha>}"
sh-note:sh-prod:(unset-glyph cha aud)
::
++ nick
:: %nick
::
:: either shows, sets or unsets nicknames
:: depending on arguments.
::
|= {her/(unit ship) nym/(unit ^nick)}
^+ ..sh-work
:: no arguments, show all
?: ?=({~ ~} +<)
%+ sh-fact %mor
%+ turn ~(tap by nicks)
|= {p/ship q/^nick}
:- %txt
"{<p>}: {<q>}"
:: show her nick
?~ nym
?> ?=(^ her)
=+ asc=(~(get by nicks) u.her)
%+ sh-fact %txt
?~ asc "{<u.her>} unbound"
"{<u.her>}: {<u.asc>}"
:: show nick ship
?~ her
%+ sh-fact %mor
%+ turn (reverse-nicks u.nym)
|= p/ship
[%txt "{<p>}: {<u.nym>}"]
%. [%nick u.her (fall nym '')]
%= sh-act
nicks
?~ u.nym
:: unset nickname
(~(del by nicks) u.her)
:: set nickname
(~(put by nicks) u.her u.nym)
==
::
++ wo-set
:: %set
::
:: enables ui setting flag.
::
|= seg/term
^+ ..sh-work
?~ seg
%+ sh-fact %mor
%+ turn ~(tap in settings.she)
|= s/term
[%txt (trip s)]
%= ..sh-work
settings.she (~(put in settings.she) seg)
==
::
++ unset
:: %unset
::
:: disables ui setting flag.
::
|= neg/term
^+ ..sh-work
%= ..sh-work
settings.she (~(del in settings.she) neg)
==
::
++ width
:: ;set width
::
:: change the display width in cli.
::
|= wid/@ud
^+ ..sh-work
..sh-work(width.she (max 30 wid))
::
++ timez
:: ;set timezone
::
:: adjust the displayed timestamp.
::
|= tim/(pair ? @ud)
^+ ..sh-work
..sh-work(timez.she tim)
::
:: #
:: # %miscellaneous
:: #
+| %miscellaneous
::
++ public
:: show/hide membership
::
:: adds or removes the circle from the public
:: membership list.
::
|= {add/? cir/circle}
(sh-act %public add cir)
::
++ help
:: %help
::
:: prints help message
::
(sh-fact %txt "see https://urbit.org/docs/using/messaging/")
--
::
++ sh-pact
:: update active aud
::
:: change currently selected audience to {aud}
:: and update the prompt.
::
|= aud/audience
^+ +>
:: ensure we can see what we send.
=+ act=(sh-pare aud)
?: =(active.she act) +>.$
sh-prod(active.she act)
::
++ sh-pare
:: adjust target list
::
:: if the audience {aud} does not contain a
:: circle we're subscribed to, add our mailbox
:: to the audience (so that we can see our own
:: message).
::
|= aud/audience
?: (sh-pear aud) aud
(~(put in aud) incir)
::
++ sh-pear
:: hearback
::
:: produces true if any circle is included in
:: our subscriptions, meaning, we hear messages
:: sent to {aud}.
::
|= aud/audience
?~ aud |
?| (~(has in sources) `circle`n.aud)
$(aud l.aud)
$(aud r.aud)
==
::
++ sh-glyf
:: decode glyph
::
:: finds the circle(s) that match a glyph.
::
|= cha/char ^- (unit audience)
=+ lax=(~(get ju binds) cha)
:: no circle.
?: =(~ lax) ~
:: single circle.
?: ?=({* ~ ~} lax) `n.lax
:: in case of multiple audiences, pick the most recently active one.
|- ^- (unit audience)
?~ grams ~
:: get first circle from a telegram's audience.
=+ pan=(silt ~(tap in aud.i.grams))
?: (~(has in lax) pan) `pan
$(grams t.grams)
::
:: #
:: # %differs
:: #
:: arms that calculate differences between datasets.
+| %differs
::
++ sh-group-diff
:: group diff parts
::
:: calculates the difference between two presence
:: lists, producing lists of removed, added and
:: changed presences.
::
|= {one/group two/group}
=| $= ret
$: old/(list (pair ship status))
new/(list (pair ship status))
cha/(list (pair ship status))
==
^+ ret
=. ret
=+ eno=~(tap by one)
|- ^+ ret
?~ eno ret
=. ret $(eno t.eno)
?: =(%gone pec.q.i.eno) ret
=+ unt=(~(get by two) p.i.eno)
?~ unt
ret(old [i.eno old.ret])
?: =(%gone pec.u.unt)
ret(old [i.eno old.ret])
?: =(q.i.eno u.unt) ret
ret(cha [[p.i.eno u.unt] cha.ret])
=. ret
=+ owt=~(tap by two)
|- ^+ ret
?~ owt ret
=. ret $(owt t.owt)
?: =(%gone pec.q.i.owt) ret
?. (~(has by one) p.i.owt)
ret(new [i.owt new.ret])
?: =(%gone pec:(~(got by one) p.i.owt))
ret(new [i.owt new.ret])
ret
ret
::
++ sh-rempe-diff
:: remotes diff
::
:: calculates the difference between two remote
:: presence maps, producing a list of removed,
:: added and changed presences maps.
::
|= {one/(map circle group) two/(map circle group)}
=| $= ret
$: old/(list (pair circle group))
new/(list (pair circle group))
cha/(list (pair circle group))
==
^+ ret
=. ret
=+ eno=~(tap by one)
|- ^+ ret
?~ eno ret
=. ret $(eno t.eno)
=+ unt=(~(get by two) p.i.eno)
?~ unt
ret(old [i.eno old.ret])
?: =(q.i.eno u.unt) ret
ret(cha [[p.i.eno u.unt] cha.ret])
=. ret
=+ owt=~(tap by two)
|- ^+ ret
?~ owt ret
=. ret $(owt t.owt)
?: (~(has by one) p.i.owt)
ret
ret(new [i.owt new.ret])
ret
::
++ sh-remco-diff
:: config diff parts
::
:: calculates the difference between two config
:: maps, producing lists of removed, added and
:: changed configs.
::
|= {one/(map circle config) two/(map circle config)}
=| $= ret
$: old/(list (pair circle config))
new/(list (pair circle config))
cha/(list (pair circle config))
==
^+ ret
=. ret
=+ eno=~(tap by one)
|- ^+ ret
?~ eno ret
=. ret $(eno t.eno)
=+ unt=(~(get by two) p.i.eno)
?~ unt
ret(old [i.eno old.ret])
?: =(q.i.eno u.unt) ret
ret(cha [[p.i.eno u.unt] cha.ret])
=. ret
=+ owt=~(tap by two)
|- ^+ ret
?~ owt ret
=. ret $(owt t.owt)
?: (~(has by one) p.i.owt)
ret
ret(new [i.owt new.ret])
ret
::
++ sh-set-diff
:: set diff
::
:: calculates the difference between two sets,
:: procuding lists of removed and added items.
::
|* {one/(set *) two/(set *)}
:- ^= old ~(tap in (~(dif in one) two))
^= new ~(tap in (~(dif in two) one))
::
:: #
:: # %printers
:: #
:: arms for printing data to the cli.
+| %printers
::
++ sh-lame
:: send error
::
:: just puts some text into the cli as-is.
::
|= txt/tape
(sh-fact [%txt txt])
::
++ sh-note
:: shell message
::
:: left-pads {txt} with heps and prints it.
::
|= txt/tape
^+ +>
=+ lis=(simple-wrap txt (sub width.she 16))
%+ sh-fact %mor
=+ ?:((gth (lent lis) 0) (snag 0 lis) "")
:- txt+(runt [14 '-'] '|' ' ' -)
%+ turn (slag 1 lis)
|=(a/tape txt+(runt [14 ' '] '|' ' ' a))
::
++ sh-prod
:: show prompt
::
:: makes and stores a move to modify the cli
:: prompt to display the current audience.
::
^+ .
%+ sh-fact %pro
:+ & %talk-line
^- tape
=/ rew/(pair (pair cord cord) audience)
[['[' ']'] active.she]
=+ cha=(~(get by bound) q.rew)
?^ cha ~[u.cha ' ']
=+ por=~(ar-prom ar q.rew)
(weld `tape`[p.p.rew por] `tape`[q.p.rew ' ' ~])
::
++ sh-rend
:: prints a telegram as rendered by ++tr-rend.
::
|= gam/telegram
^+ +>
=+ lis=~(tr-rend tr settings.she gam)
?~ lis +>.$
%+ sh-fact %mor
%+ turn `(list tape)`lis
=+ nom=(scag 7 (cite:title self))
|= t/tape
?. ?& (~(has in settings.she) %notify)
?=(^ (find nom (slag 15 t)))
==
[%txt t]
[%mor [%txt t] [%bel ~] ~]
::
++ sh-numb
:: prints a message number, left-padded by heps.
::
|= num/@ud
^+ +>
=+ bun=(scow %ud num)
%+ sh-fact %txt
(runt [(sub 13 (lent bun)) '-'] "[{bun}]")
::
++ sh-cure
:: renders a security kind.
::
|= a/security
^- tape
(scow %tas a)
::
++ sh-scis
:: render status
::
:: gets the presence of {saz} as a tape.
::
|= sat/status
^- tape
['%' (trip pec.sat)]
::
++ sh-show-status
:: prints presence changes to the cli.
::
|= {cir/circle who/ship cur/status dif/diff-status}
^+ +>
?: (~(has in settings.she) %quiet) +>
%- sh-note
%+ weld
(weld ~(cr-phat cr cir) ": ")
?- -.dif
$full
"hey {(scow %p who)} {(scow %tas pec.sat.dif)}"
::
$presence
"see {(scow %p who)} {(scow %tas pec.dif)}"
::
$human
%+ weld "nom {(scow %p who)}"
?: ?=($true -.dif.dif) ~
=- " '{(trip (fall han.man.cur ''))}' -> '{-}'"
%- trip
=- (fall - '')
?- -.dif.dif
$full han.man.dif.dif
$handle han.dif.dif
==
::
$remove
"bye {(scow %p who)}"
==
::
++ sh-show-config
:: prints config changes to the cli.
::
|= {cir/circle cur/config dif/diff-config}
^+ +>
?: (~(has in settings.she) %quiet) +>
?: ?=($full -.dif)
=. +>
(sh-note (weld "new " (~(cr-show cr cir) ~)))
=. +> $(dif [%caption cap.cof.dif])
$(dif [%filter fit.cof.dif])
?: ?=($remove -.dif)
(sh-note (weld "rip " (~(cr-show cr cir) ~)))
?: ?=(?($usage $read) -.dif) +>
%- sh-note
%+ weld
(weld ~(cr-phat cr cir) ": ")
?- -.dif
$source
%+ weld ?:(add.dif "onn " "off ")
~(cr-full cr cir.src.dif)
::
$caption
"cap: {(trip cap.dif)}"
::
$filter
;: weld
"fit: caps:"
?:(cas.fit.dif "Y" "n")
" unic:"
?:(utf.fit.dif "✔" "n")
==
::
$secure
"sec {(trip sec.con.cur)} -> {(trip sec.dif)}"
::
$permit
%+ weld
=? add.dif
?=(?($channel $mailbox) sec.con.cur)
!add.dif
?:(add.dif "inv " "ban ")
^- tape
%- ~(rep in sis.dif)
|= {s/ship t/tape}
=? t ?=(^ t) (weld t ", ")
(weld t (cite:title s))
==
::
++ sh-gram
:: show telegram
::
:: prints the telegram. every fifth message,
:: print the message number also.
::
|= gam/telegram
^+ +>
=+ num=(~(got by known) uid.gam)
=. +>.$
:: if the number isn't directly after latest, print it always.
?. =(num +(latest.she))
(sh-numb num)
:: if the number is directly after latest, print every fifth.
?. =(0 (mod num 5)) +>.$
(sh-numb num)
(sh-rend(latest.she num) gam)
::
++ sh-grams
:: prints multiple telegrams.
::
|= gaz/(list telegram)
^+ +>
?~ gaz +>
$(gaz t.gaz, +> (sh-gram i.gaz))
--
--
::
:: #
:: # %renderers
:: #
:: rendering cores.
+| %renderers
::
++ cr
:: circle renderer
::
:: used in both circle and ship rendering.
::
|_ :: one: the circle.
::
one/circle
::
++ cr-beat
:: {one} more relevant?
::
:: returns true if one is better to show, false
:: otherwise. prioritizes: our > main > size.
::
|= two/circle
^- ?
:: the circle that's ours is better.
?: =(self hos.one)
?. =(self hos.two) &
?< =(nom.one nom.two)
:: if both circles are ours, the main story is better.
?: =(%inbox nom.one) &
?: =(%inbox nom.two) |
:: if neither are, pick the "larger" one.
(lth nom.one nom.two)
:: if one isn't ours but two is, two is better.
?: =(self hos.two) |
?: =(hos.one hos.two)
:: if they're from the same ship, pick the "larger" one.
(lth nom.one nom.two)
:: if they're from different ships, neither ours, pick hierarchically.
(lth (xeb hos.one) (xeb hos.two))
::
++ cr-best
:: returns the most relevant circle.
::
|= two/circle
?:((cr-beat two) one two)
::
++ cr-curt
:: prints a ship name in 14 characters.
::
:: left-pads with spaces. {mup} signifies
:: "are there other targets besides this one?"
::
|= mup/?
^- tape
=+ raw=(cite:title hos.one)
(runt [(sub 14 (lent raw)) ' '] raw)
::
++ cr-nick
:: get nick for ship, or shortname if no nick.
::
:: left-pads with spaces.
::
|= aud/audience
^- tape
=/ nic/(unit cord)
?: (~(has by nicks) hos.one)
(~(get by nicks) hos.one)
%- ~(rep in aud)
|= {cir/circle han/(unit cord)}
?^ han han
=+ gop=(~(get by remotes) cir)
?~ gop ~
han.man:(~(gut by u.gop) hos.one *status)
?~ nic (cr-curt |)
=+ raw=(scag 14 (trip u.nic))
=+ len=(sub 14 (lent raw))
(weld (reap len ' ') raw)
::
:: todo: figure out why enabling the doccord causes a nest fail, even when
:: attached to the arm instead of the product.
::
++ cr-phat ::: render accurately
::: prints a circle fully, but still taking
::: "shortcuts" where possible:
::: ":" for local mailbox, "~ship" for foreign
::: mailbox, "%channel" for local circle,
::: "/channel" for parent circle.
::
^- tape
?: =(hos.one self)
?: =(nom.one inbox)
":"
['%' (trip nom.one)]
=+ wun=(cite:title hos.one)
?: =(nom.one %inbox)
wun
?: =(hos.one (^sein:title self))
['/' (trip nom.one)]
:(welp wun "/" (trip nom.one))
::
++ cr-full (cr-show ~) :: render full width
::
++ cr-show
:: renders a circle as text.
::
:: moy: multiple circles in audience?
|= moy/(unit ?)
^- tape
:: render circle (as glyph if we can).
?~ moy
=+ cha=(~(get by bound) one ~ ~)
=- ?~(cha - "{u.cha ~}")
~(cr-phat cr one)
(~(cr-curt cr one) u.moy)
--
::
++ ar
:: audience renderer
::
:: used for representing audiences (sets of circles)
:: as tapes.
::
|_ :: aud: members of the audience.
::
aud/audience
::
++ ar-best
:: find the most relevant circle in the set.
::
^- (unit circle)
?~ aud ~
:- ~
|- ^- circle
=+ lef=`(unit circle)`ar-best(aud l.aud)
=+ rit=`(unit circle)`ar-best(aud r.aud)
=? n.aud ?=(^ lef) (~(cr-best cr n.aud) u.lef)
=? n.aud ?=(^ rit) (~(cr-best cr n.aud) u.rit)
n.aud
::
++ ar-deaf
:: remove ourselves from the audience.
::
^+ .
.(aud (~(del in aud) `circle`incir))
::
++ ar-maud
:: multiple audience
::
:: checks if there's multiple circles in the
:: audience via pattern matching.
::
^- ?
=. . ar-deaf
!?=($@(~ {* ~ ~}) aud)
::
++ ar-phat
:: render all circles, no glyphs.
::
^- tape
%- ~(rep in aud)
|= {c/circle t/tape}
=? t ?=(^ t)
(weld t ", ")
(weld t ~(cr-phat cr c))
::
++ ar-prom
:: render all circles, ordered by relevance.
::
^- tape
=. . ar-deaf
=/ all
%+ sort `(list circle)`~(tap in aud)
|= {a/circle b/circle}
(~(cr-beat cr a) b)
=+ fir=&
|- ^- tape
?~ all ~
;: welp
?:(fir "" " ")
(~(cr-show cr i.all) ~)
$(all t.all, fir |)
==
::
++ ar-whom
:: render sender as the most relevant circle.
::
(~(cr-show cr (need ar-best)) ~ ar-maud)
::
++ ar-dire
:: returns true if circle is a mailbox of ours.
::
|= cir/circle ^- ?
?& =(hos.cir self)
=+ sot=(~(get by mirrors) cir)
&(?=(^ sot) ?=($mailbox sec.con.u.sot))
==
::
++ ar-glyf
:: todo: another place where doccords break things.
::
::: audience glyph
:::
::: get the glyph that corresponds to the audience.
::: for mailbox messages and complex audiences, use
::: reserved "glyphs".
::
^- tape
=+ cha=(~(get by bound) aud)
?^ cha ~[u.cha]
?. (lien ~(tap by aud) ar-dire)
"*"
?: ?=({^ ~ ~} aud)
":"
";"
--
::
++ tr
:: telegram renderer
::
:: responsible for converting telegrams and
:: everything relating to them to text to be
:: displayed in the cli.
::
|_ $: :: sef: settings flags.
:: who: author.
:: sen: unique identifier.
:: aud: audience.
:: wen: timestamp.
:: sep: message contents.
::
sef/(set term)
who/ship
sen/serial
aud/audience
wen/@da
sep/speech
==
::
++ tr-fact
:: activate effect
::
:: produces sole-effect for printing message
:: details.
::
^- sole-effect:sole-sur
~[%mor [%tan tr-meta] tr-body]
::
++ tr-rend
:: renders a telegram
::
:: the first line will contain the author and
:: optional timestamp.
::
^- (list tape)
=/ wyd
%+ sub width.cli :: termwidth,
%+ add 14 :: minus author,
?:((~(has in sef) %showtime) 10 0) :: minus timestamp.
=+ txs=(tr-text wyd)
?~ txs ~
:: render the author.
=/ nom/tape
?: (~(has in sef) %nicks)
(~(cr-nick cr [who %inbox]) aud)
(~(cr-curt cr [who %inbox]) |)
:: regular indent.
=/ den/tape
(reap (lent nom) ' ')
:: timestamp, if desired.
=/ tam/tape
?. (~(has in sef) %showtime) ""
=. wen
%. [wen (mul q.timez.cli ~h1)]
?:(p.timez.cli add sub)
=+ dat=(yore wen)
=/ t
|= a/@
%+ weld
?:((lth a 10) "0" ~)
(scow %ud a)
=/ time
;: weld
"~" (t h.t.dat)
"." (t m.t.dat)
"." (t s.t.dat)
==
%+ weld
(reap (sub +(wyd) (min wyd (lent (tuba i.txs)))) ' ')
time
%- flop
%+ roll `(list tape)`txs
|= {t/tape l/(list tape)}
?~ l [:(weld nom t tam) ~]
[(weld den t) l]
::
++ tr-meta
:: metadata
::
:: builds string that display metadata, including
:: message serial, timestamp, author and audience.
::
^- tang
=. wen (sub wen (mod wen (div wen ~s0..0001))) :: round
=+ hed=leaf+"{(scow %uv sen)} at {(scow %da wen)}"
=/ cis
%+ turn ~(tap in aud)
|= a/circle
leaf+~(cr-full cr a)
[%rose [" " ~ ~] [hed >who< [%rose [", " "to " ~] cis] ~]]~
::
++ tr-body
:: message content
::
:: long-form display of message contents, specific
:: to each speech type.
::
|- ^- sole-effect:sole-sur
?- -.sep
$lin
tan+~[leaf+"{?:(pat.sep "@ " "")}{(trip msg.sep)}"]
::
$url
url+(crip (apix:en-purl:html url.sep))
::
$exp
mor+~[txt+"# {(trip exp.sep)}" tan+res.sep]
::
$ire
=+ num=(~(get by known) top.sep)
?~ num $(sep sep.sep)
=+ gam=(snag (sub count +(u.num)) grams)
=- mor+[tan+- $(sep sep.sep) ~]
%- flop %+ weld
:_ ~ :- %leaf
%+ weld "in reply to: {(cite:title aut.gam)}: "
"[{(scow %ud u.num)}]"
%+ turn (~(tr-text tr sef gam) width.cli)
|=(t/tape [%leaf t])
::
$fat
[%mor $(sep sep.sep) tan+(tr-tach tac.sep) ~]
::
$inv
:- %tan
:_ ~
:- %leaf
%+ weld
?: inv.sep
"you have been invited to "
"you have been banished from "
~(cr-phat cr cir.sep)
::
$app
[%mor tan+~[leaf+"[{(trip app.sep)}]: "] $(sep sep.sep) ~]
==
::
++ tr-tach
:: renders an attachment.
::
|= att/attache
^- tang
?- -.att
$name (welp $(att tac.att) leaf+"= {(trip nom.att)}" ~)
$tank +.att
$text (turn (flop `(list cord)`+.att) |=(b/cord leaf+(trip b)))
==
::
++ tr-chow
:: truncate
::
:: truncates the {txt} to be of max {len}
:: characters. if it does truncate, indicates it
:: did so by appending _ or ….
::
|= {len/@u txt/tape}
^- tape
?: (gth len (lent txt)) txt
=. txt (scag len txt)
|-
?~ txt txt
?: =(' ' i.txt)
|-
:- '_'
?. ?=({$' ' *} t.txt)
t.txt
$(txt t.txt)
?~ t.txt "…"
[i.txt $(txt t.txt)]
::
++ tr-text
:: compact contents
::
:: renders just the most important data of the
:: message. if possible, these stay within a single
:: line.
::
:: pre: replace/append line prefix
::TODO this should probably be redone someday.
=| pre/(unit (pair ? tape))
|= wyd/@ud
^- (list tape)
?- -.sep
$fat
%+ weld $(sep sep.sep)
^- (list tape)
?+ -.tac.sep [" attached: ..." ~]
$name [(scag wyd " attached: {(trip nom.tac.sep)}") ~]
==
::
$exp
:- (tr-chow wyd '#' ' ' (trip exp.sep))
?~ res.sep ~
=- [' ' (tr-chow (dec wyd) ' ' -)]~
~(ram re (snag 0 `(list tank)`res.sep))
::
$ire
$(sep sep.sep, pre `[| "^ "])
::
$url
:_ ~
=+ ful=(apix:en-purl:html url.sep)
=+ pef=q:(fall pre [p=| q=""])
:: clean up prefix if needed.
=? pef =((scag 1 (flop pef)) " ")
(scag (dec (lent pef)) pef)
=. pef (weld "/" pef)
=. wyd (sub wyd +((lent pef))) :: account for prefix.
:: if the full url fits, just render it.
?: (gte wyd (lent ful)) :(weld pef " " ful)
:: if it doesn't, prefix with _ and render just (the tail of) the domain.
%+ weld (weld pef "_")
=+ hok=r.p.p.url.sep
=- (swag [a=(sub (max wyd (lent -)) wyd) b=wyd] -)
^- tape
=< ?: ?=(%& -.hok)
(reel p.hok .)
+:(scow %if p.hok)
|= {a/knot b/tape}
?~ b (trip a)
(welp b '.' (trip a))
::
$lin
:: glyph prefix
=/ pef/tape
?: &(?=(^ pre) p.u.pre) q.u.pre
?: pat.sep " "
=- (weld - q:(fall pre [p=| q=" "]))
%~ ar-glyf ar
?: =(who self) aud
(~(del in aud) [who %inbox])
=/ lis/(list tape)
%+ simple-wrap
`tape``(list @)`(tuba (trip msg.sep))
(sub wyd (min (div wyd 2) (lent pef)))
=+ lef=(lent pef)
=+ ?:((gth (lent lis) 0) (snag 0 lis) "")
:- (weld pef -)
%+ turn (slag 1 lis)
|=(a/tape (runt [lef ' '] a))
::
$inv
:_ ~
%+ tr-chow wyd
%+ weld
?: inv.sep
" invited you to "
" banished you from "
~(cr-phat cr cir.sep)
::
$app
$(sep sep.sep, pre `[& "[{(trip app.sep)}]: "])
==
--
::
:: #
:: # %events
:: #
+| %events
::
++ quit-server-client
|= wir/wire
^- (quip move _+>)
[[peer-client]~ +>]
::
++ quit-server-inbox
|= wir/wire
^- (quip move _+>)
[[peer-inbox]~ +>]
::
++ peer
:: incoming subscription on pax.
::
|= pax/path
^- (quip move _+>)
?. =(src.bol our.bol)
~! [%peer-talk-stranger src.bol]
!!
?. ?=({$sole *} pax)
~! [%peer-talk-strange pax]
!!
ta-done:ta-console:ta
::
++ diff-hall-prize
:: accept query answer
::
|= {way/wire piz/prize}
^- (quip move _+>)
ta-done:(ta-take:ta piz)
::
++ diff-hall-rumor
:: accept query change
::
|= {way/wire rum/rumor}
^- (quip move _+>)
ta-done:(ta-hear:ta rum)
::
++ poke-sole-action
:: incoming sole action. process it.
::
|= act/sole-action:sole-sur
ta-done:(ta-sole:ta act)
::
::TODO for debug purposes. remove eventually.
:: users beware, here be dragons.
++ poke-noun
|= a/@t
^- (quip move _+>)
?: =(a 'check')
~& 'verifying message reference integrity...'
=- ~&(- [~ +>.$])
~& [%count--lent count (lent grams)]
=+ %- ~(rep by known)
|= {{u/serial a/@ud} k/@ud m/@ud}
:- ?:((gth a k) a k)
?: =(u uid:(snag (sub count +(a)) grams)) m +(m)
:- %check-talk
[known=k mismatch=m]
?: =(a 'rebuild')
~& 'rebuilding message references...'
=+ %+ reel grams
|= {t/telegram c/@ud k/(map serial @ud)}
[+(c) (~(put by k) uid.t c)]
[~ +>.$(count c, known k)]
?: =(a 'reconnect')
~& 'disconnecting and reconnecting to hall...'
:_ +>
:~ [ost.bol %pull /server/client server ~]
[ost.bol %pull /server/inbox server ~]
peer-client
peer-inbox
==
?: =(a 'reset')
~& 'full reset incoming, hold on to your cli...'
:_ +>(grams ~, known ~, count 0, last 0)
:~ [ost.bol %pull /server/client server ~]
[ost.bol %pull /server/inbox server ~]
peer-client
peer-inbox
==
:: this deletes a message from your backlog, and may
:: make talk throw stack traces.
:: **aka don't run this!**
?: =(a 'screw')
~& 'screwing things up...'
:- ~
+>(grams (oust [0 1] grams))
[~ +>]
::
++ coup-client-action
:: accept n/ack
::
|= {wir/wire fal/(unit tang)}
^- (quip move _+>)
?~ fal [~ +>]
%- (slog leaf+"action failed: " u.fal)
[~ +>]
--
Reference in New Issue View Git Blame Copy Permalink