/- *modulo /+ *server /= index /^ octs /; as-octs:mimes:html /: /===/app/modulo/index /html/ /= modulo-js /^ octs /; as-octs:mimes:html /: /===/app/modulo/script /js/ =, format |% :: +move: output effect :: +$ move [bone card] :: +card: output effect payload :: +$ card $% [%connect wire [(unit @t) (list @t)] term] [%disconnect wire [(unit @t) (list @t)]] [%http-response =http-event:http] [%poke wire dock poke] [%diff %json json] == +$ poke $% [%modulo-bind app=term] [%modulo-unbind app=term] == :: +$ state $% $: %0 session=(map term @t) order=(list term) cur=(unit [term @]) == == :: ++ session-as-json |= [cur=(unit [term @]) session=(map term @t) order=(list term)] ^- json ?~ cur *json %- pairs:enjs :~ [%app %s -.u.cur] [%url %s (~(got by session) -.u.cur)] :- %list :- %a %+ turn order |= [a=term] [%s a] == :: -- :: |_ [bow=bowl:gall sta=state] :: ++ this . :: ++ prep |= old=(unit *) ^- (quip move _this) ?~ old :_ this [ost.bow [%connect / [~ /] %modulo]]~ [~ this(sta *state)] :: alerts us that we were bound. we need this because the vane calls back. :: ++ bound |= [wir=wire success=? binding=binding:http-server] [~ this] :: ++ peer-applist |= [pax=path] ^- (quip move _this) :_ this [ost.bow %diff %json (session-as-json cur.sta session.sta order.sta)]~ :: ++ session-js ^- octs ?~ cur.sta *octs %- as-octs:mimes:html %- crip ;: weld (trip 'window.onload = function() {') "window.ship = '{(trip (rsh 3 1 (crip )))}';" " window.state = " (en-json:html (session-as-json cur.sta session.sta order.sta)) (trip '}();') %- trip ''' document.onkeydown = (event) => { if (!event.metaKey || event.keyCode !== 75) { return; } window.parent.postMessage("commandPalette", "*"); }; ''' == :: +poke-handle-http-request: received on a new connection established :: ++ poke-handle-http-request %- (require-authorization ost.bow move this) |= =inbound-request:http-server ^- (quip move _this) :: =+ request-line=(parse-request-line url.request.inbound-request) =/ name=@t =+ back-path=(flop site.request-line) ?~ back-path !! i.back-path :: ?: =(name 'session') :_ this :~ ^- move :- ost.bow :* %http-response [%start [200 ['content-type' 'application/javascript']~] [~ session-js] %.y] == == ?: =(name 'script') :_ this :~ ^- move :- ost.bow :* %http-response [%start [200 ['content-type' 'application/javascript']~] [~ modulo-js] %.y] == == :: :_ this :~ ^- move :- ost.bow :* %http-response [%start [200 ['content-type' 'text/html']~] [~ index] %.y] == == :: +poke-handle-http-cancel: received when a connection was killed :: ++ poke-handle-http-cancel |= =inbound-request:http-server ^- (quip move _this) :: the only long lived connections we keep state about are the stream ones. :: [~ this] :: ++ poke-modulo-bind |= bin=term ^- (quip move _this) =/ url (crip "~{(scow %tas bin)}") ?: (~(has by session.sta) bin) [~ this] :- [`move`[ost.bow %connect / [~ /[url]] bin] ~] %= this session.sta (~(put by session.sta) bin url) :: order.sta (weld order.sta ~[bin]) :: cur.sta ?~ cur.sta `[bin 0] cur.sta == :: ++ poke-modulo-unbind |= bin=term ^- (quip move _this) =/ url (crip "~{(scow %tas bin)}") ?. (~(has by session.sta) bin) [~ this] =/ ind (need (find ~[bin] order.sta)) =/ neworder (oust [ind 1] order.sta) :- [`move`[ost.bow %disconnect / [~ /(crip "~{(scow %tas bin)}")]] ~] %= this session.sta (~(del by session.sta) bin) order.sta neworder cur.sta :: ?: =(1 (lent order.sta)) ~ ?: (lth ind +:(need cur.sta)) `[-:(need cur.sta) (dec +:(need cur.sta))] ?: =(ind +:(need cur.sta)) `[(snag 0 neworder) 0] cur.sta == :: ++ poke-modulo-command |= com=command ^- (quip move _this) =/ length (lent order.sta) ?~ cur.sta [~ this] ?: =(length 1) [~ this] =/ new-cur=(unit [term @]) ?- -.com %forward ?: =((dec length) +.u.cur.sta) `[(snag 0 order.sta) 0] =/ ind +(+.u.cur.sta) `[(snag ind order.sta) ind] %back ?: =(0 +.u.cur.sta) =/ ind (dec length) `[(snag ind order.sta) ind] =/ ind (dec +.u.cur.sta) `[(snag ind order.sta) ind] %go =/ ind (find [app.com]~ order.sta) ?~ ind cur.sta `[app.com u.ind] == :_ this(cur.sta new-cur) %+ turn (prey:pubsub:userlib /applist bow) |= [=bone ^] [bone %diff %json (session-as-json new-cur session.sta order.sta)] :: --