Split repo into gall and shrub version

This commit is contained in:
Robin Guerrier 2024-10-07 02:12:27 -04:00
parent e511c5a975
commit 604ebdd7fd
8 changed files with 2059 additions and 1 deletions

2
.gitignore vendored
View File

@ -2,4 +2,4 @@ notes.md
notes2.md
notes.js
copy.sh
/app
/desk/app

133
shrub/README.md Normal file
View File

@ -0,0 +1,133 @@
# %mast, shrubbery edition:
### A framework for building reactive Web clients as shrubs, purely in hoon.
---
### Introduction
To understand the %mast front-end model, imagine the client as a shrub within your ship, instead of an application on the browser. A mast shrub is the source of truth for the state of your front-end, and it should contain all client-side logic to transition this state. Your mast shrub will act as an interface that renders the state of some other shrub.
Mast shrubs are spawned and managed by %mast (which is itself a shrub). %mast will handle everything related to connecting with and updating the browser. Your shrub needs to do only two things: have `manx` state, and take `ui-event` pokes. Your shrub will also have a `%src` dependency, which provides your back-end data.
Whenever you change the `manx` state of your shrub, %mast will automatically sync the browser with this state. All display updates happen like this; you never need to explicitly poke anything to %mast or interact with the browser.
%mast will poke your shrub with a `ui-event`, which represents an event that happens on the browser, such as a click or a form submit. A ui-event is of the type `[=path data=(map @t @t)]`. The path is an identifier for the event that you will have written in an attribute in your Sail. When handling a ui-event poke, you can switch over this path to implement your event handler logic. The data map contains any data that you might return from the browser with the event.
In addition to %mast attributes, there is also a %mast component element. This element lets you plug the interface of one shrub into the interface of another shrub.
---
### In your Sail
%mast uses three main attributes: `event`, `return`, and `key`, along with `debounce`, `throttle`, `js-on-event`, `js-on-add`, and `js-on-delete`.
#### The event attribute
The `event` attribute lets you add event listeners to elements. The value of the `event` attribute is a path where the first segment is the name of an event listener (minus the "on" prefix), followed by any number of segments. %mast will add the specified event listener to the element, and when the event is triggered your shrub will receive a `ui-event` poke.
An element with an event attribute looks like this:
```hoon
;div(event "/click/example-event");
```
- Note: you can add multiple event listeners on a single element by writing multiple paths separated by whitespace.
#### The return attribute
The `return` attribute lets you to specify data to return from the event. This data will be contained in the data map of the `ui-event` poke. Using this attribute requires some knowledge of the DOM API. If you only need form data instead of general purpose data on an event, you can use the form API instead (see the section on implementing forms below).
The value of the `return` attribute is also written as a path. A number of paths may be written, separated by whitespace. The first segment of the path refers to the object on the client to return data from. There are three options:
1) `"/target/..."` for the current target, i.e. the element on which the event was triggered,
2) `"/event/..."` for the event object,
3) `"/your-element-id/..."` for any other element by id.
The second segment of the path is the property to return from the object. For example: `"/target/value"` or `"/my-element/textContent"` or `"/event/clientX"`.
- Note: the property name is exactly the same as what you would access on the object in JavaScript, so you will need to use camel case in some situations.
#### Implementing forms
There are two ways to implement forms in %mast. You can either use a %mast `return` attribute to return the values of inputs on event, or you can use the typical `<form>` element API.
To make use of the form API, just add a "/submit/..." `event` attribute on your form element to add a sumbit event listener. If you do this, your shrub will receive a `ui-event` poke on form submit, and the value of each input in the form will be included in the data map of the event poke with each input's `name` attribute as its key.
#### The key attribute
The `key` attribute is not necessary to use, but it is best practice when you have a list of elements that will change.
A `key` is a globally unique value which identifies the element (two distinct elements in your Sail should never have the same key). %mast adds location based keys to your elements by default, but when you provide information about the identity of the element by specifying the `key`, it allows %mast to make more efficient display updates.
#### Other attributes
The attributes `debounce` and `throttle` let you add debouncing and throttling to events when placed on an element with an `event` attribute. These attributes take a number value for their duration in seconds.
The `js-on-event`, `js-on-add`, and `js-on-delete` events allow you to run arbitrary JavaScript when placed on an element that either has an `event` triggered on it, when the element is added to the DOM through a diff, or deleted through a diff.
---
### Shrub components
Any mast shrub that you write can also function as a component within some other mast shrub. This lets you split up your interface into composable and reusable building blocks for rendering your shrubs, which each serve as standalone UIs.
To add a shrub component in your Sail, write an element where the name is prefixed with `imp_` followed by the name of your shrub's /imp file. This element also needs to have a text node that encodes the `pith` of the %src dependency that your shrub renders. These component elements can be dynamically added or removed like any other element.
For example:
```hoon
;imp_my-mast-shrub: /pith/to/src
```
---
### Examples
The %mast related IO in your shrub would look essentially like this:
```hoon
++ poke
|= [=stud:neo =vase]
^- (quip card:neo pail:neo)
?+ stud !!
::
%ui-event
=/ event !<(ui-event vase)
?+ path.event !!
::
[%click %my-button ~]
:: handle the click event ...
::
[%submit %my-form ~]
:: get form data from the map:
=/ data=@t (~(got by data.event) 'my-input-name')
:: handle the form ...
::
==
::
%rely
:: on a change in your dependency's state
:: produce new manx, and update the shrub's manx state:
`manx/!>((render-my-sail bowl))
::
==
```
And the corresponding Sail would look something like this:
```hoon
++ render-my-sail
|= =bowl:neo
^- manx
;html
;head;
;body
;button(event "/click/my-button"): click me
;form(event "/submit/my-form")
;input(name "my-input-name");
==
==
==
```

327
shrub/fil/mast-js.js Normal file
View File

@ -0,0 +1,327 @@
let pith;
let ship;
let eventSource;
let activeSubIds= {};
let channelMessageId = 0;
let mastLogs = false;
const heartbeatMins = 30;
const channelId = `${Date.now()}${Math.floor(Math.random() * 100)}`;
const channelPath = `${window.location.origin}/~/channel/${channelId}`;
const baseSubPath = '/eyre-chan/mast';
const gallApp = 'neo';
addEventListener('DOMContentLoaded', async () => {
pith = document.documentElement.getAttribute('pith');
ship = document.documentElement.getAttribute('ship');
let subKey = document.body.getAttribute('key');
if (!subKey) subKey = document.body.firstElementChild.getAttribute('key');
await connectToShip(subKey);
let eventElements = document.querySelectorAll('[event]');
eventElements.forEach(el => setEventListeners(el));
handleImpElements([...document.querySelectorAll('[rope]')]);
window.addEventListener('beforeunload', () => {
const subKeys = [...document.querySelectorAll('[rope]')].map(el => {
el.getAttribute('key');
});
subKeys.push(subKey);
closeSubscriptions(subKeys);
});
setHeartbeat();
});
async function connectToShip(subKey) {
await fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(makeSubscribeBody(subKey))
});
eventSource = new EventSource(channelPath);
eventSource.addEventListener('message', handleChannelStream);
};
function setEventListeners(el) {
const eventAttrVals = el.getAttribute('event');
const returnAttrVals = el.getAttribute('return');
const throttleMs = Number(el.getAttribute('throttle')) * 1000;
const debounceMs = Number(el.getAttribute('debounce')) * 1000;
eventAttrVals.split(/\s+/).forEach(eventAttr => {
let splitEventAttr = eventAttr.split('/');
if (splitEventAttr[0] === '') splitEventAttr.shift();
const eventType = splitEventAttr[0];
if (throttleMs) {
el.addEventListener(
eventType,
pokeThrottle(throttleMs, eventType, eventAttr, returnAttrVals)
);
} else if (debounceMs) {
el.addEventListener(
eventType,
pokeDebounce(debounceMs, eventType, eventAttr, returnAttrVals)
);
} else {
el.addEventListener(eventType, (e) => {
pokeShip(e, e.currentTarget, eventType, eventAttr, returnAttrVals)
});
};
});
};
function setHeartbeat() {
setInterval(sendHeartbeat, (heartbeatMins * 60 * 1000));
}
function sendHeartbeat() {
let eles = document.querySelectorAll('[rope]');
let vals = Array.from(eles).map(el => Number(el.getAttribute('rope')));
fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(makePokeBody(
['beat', vals]
))
});
}
function pokeThrottle(ms, ...pokeArgs) {
let ready = true
return (e) => {
if (!ready) return
ready = false
window.setTimeout(() => {
ready = true
}, ms)
pokeShip(e, e.currentTarget, ...pokeArgs)
}
}
function pokeDebounce(ms, ...pokeArgs) {
let timeoutId = null
return (e) => {
window.clearTimeout(timeoutId)
timeoutId = window.setTimeout(() => pokeShip(e, e.target, ...pokeArgs), ms)
}
}
function pokeShip(event, target, eventType, eventAttr, returnAttrVals) {
let parentComponent = target.closest('[rope]');
const rope = Number(parentComponent.getAttribute('rope'));
const jsOnEvent = target.getAttribute('js-on-event');
if (jsOnEvent) {
eval?.(`"use strict"; ${jsOnEvent}`);
};
let uiEventData = {};
if (returnAttrVals) {
uiEventData = handleReturnAttr(event, target, returnAttrVals);
};
if (eventType === 'submit') {
event.preventDefault();
const formData = new FormData(target);
formData.forEach((v, k) => { uiEventData[k] = v });
target.reset();
};
fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(makePokeBody(
['poke', {
rope,
path: eventAttr,
data: uiEventData
}]
))
});
};
function handleReturnAttr(event, target, returnAttrVals) {
let returnData = {};
returnAttrVals.split(/\s+/).forEach((returnAttr) => {
let splitReturnAttr = returnAttr.split('/');
if (splitReturnAttr[0] === '') splitReturnAttr.shift();
const returnObjSelector = splitReturnAttr[0];
const key = splitReturnAttr[1];
if (returnObjSelector === 'event') {
if (!(key in event)) {
console.error(`Property: ${key} does not exist on the event object`);
return;
}
returnData[returnAttr] = String(event[key]);
} else {
let returnObj;
if (returnObjSelector === 'target') {
returnObj = target;
} else {
const linkedEl = document.getElementById(returnObjSelector);
if (!linkedEl) {
console.error(`No element found for id: ${returnObjSelector}`);
return;
}
returnObj = linkedEl;
}
let dat = returnObj.getAttribute(key) ?? returnObj[key];
if (!dat) {
console.error(`The value of: ${key} is null or does not exist on the specified object`);
return;
}
returnData[returnAttr] = String(dat);
}
})
return returnData;
}
function handleChannelStream(event) {
const streamResponse = JSON.parse(event.data);
if (mastLogs) console.log(streamResponse);
if (streamResponse.response !== 'diff') return;
fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(makeAck(streamResponse.id))
});
if (!Object.values(activeSubIds).includes(streamResponse.id)) return;
streamResponse.json.forEach(gustObj => {
switch (gustObj.p) {
case 'd':
gustObj.q.forEach(key => {
let toRemove = document.querySelector(`[key="${key}"]`);
const jsOnDelete = toRemove.getAttribute('js-on-delete');
if (jsOnDelete) {
eval?.(`"use strict"; ${jsOnDelete}`);
};
let impEls = [...toRemove.querySelectorAll('[rope]')];
if (toRemove.hasAttribute('rope')) impEls.push(toRemove);
if (impEls.length > 0) {
const subKeys = impEls.map(el => el.getAttribute('key'));
closeSubscriptions(subKeys);
};
toRemove.remove();
});
break;
case 'n':
let parent = document.querySelector(`[key="${gustObj.q}"]`);
if (gustObj.r === 0) {
parent.insertAdjacentHTML('afterbegin', gustObj.s);
} else if (gustObj.r === parent.childNodes.length) {
parent.insertAdjacentHTML('beforeend', gustObj.s);
} else {
let indexTarget = parent.childNodes[gustObj.r];
if (indexTarget.nodeType === 1) {
indexTarget.insertAdjacentHTML('beforebegin', gustObj.s);
} else {
let placeholder = document.createElement('div');
parent.insertBefore(placeholder, indexTarget);
placeholder = parent.childNodes[gustObj.r];
placeholder.outerHTML = gustObj.s;
};
};
let newNode = parent.childNodes[gustObj.r];
if (newNode.nodeType === 1) {
if (newNode.getAttribute('event')) {
setEventListeners(newNode);
};
if (newNode.childElementCount > 0) {
let needingListeners = newNode.querySelectorAll('[event]');
needingListeners.forEach(el => setEventListeners(el));
};
if (newNode.hasAttribute('rope')) {
handleImpElements([newNode]);
} else {
handleImpElements([...newNode.querySelectorAll('[rope]')]);
};
const jsOnAdd = newNode.getAttribute('js-on-add');
if (jsOnAdd) {
eval?.(`"use strict"; ${jsOnAdd}`);
};
};
break;
case 'm':
let fromNode = document.querySelector(`[key="${gustObj.q}"]`);
const fromIndex = [ ...fromNode.parentNode.childNodes ].indexOf(fromNode);
if (fromIndex < gustObj.r) gustObj.r++;
let toNode = fromNode.parentNode.childNodes[gustObj.r];
fromNode.parentNode.insertBefore(fromNode, toNode);
break;
case 'c':
let targetNode = document.querySelector(`[key="${gustObj.q}"]`);
if (gustObj.r.length) {
gustObj.r.forEach(attr => {
if (attr === 'event') {
let eventVal = targetNode.getAttribute('event').split('/');
if (eventVal[0] === '') eventVal.shift();
const eventType = eventVal[0];
targetNode[`on${eventType}`] = null;
};
targetNode.removeAttribute(attr);
});
};
if (gustObj.s.length) {
gustObj.s.forEach(attr => {
const name = attr[0];
const value = attr[1];
targetNode.setAttribute(name, value);
if (name === 'event') setEventListeners(targetNode);
});
};
break;
case 't':
let textWrapperNode = document.querySelector(`[key="${gustObj.q}"]`);
textWrapperNode.textContent = gustObj.r;
break;
case 'k':
let impPlaceholder = document.querySelector(`[key="${gustObj.q}"]`);
impPlaceholder.outerHTML = gustObj.r;
let imp = document.querySelector(`[key="${gustObj.q}"]`);
if (imp.hasAttribute('event')) {
setEventListeners(imp);
};
if (imp.childElementCount > 0) {
let needingListeners = imp.querySelectorAll('[event]');
needingListeners.forEach(el => setEventListeners(el));
};
handleImpElements([...imp.querySelectorAll('[rope]')]);
break;
};
});
};
function handleImpElements(impElements) {
impElements.forEach(el => {
let key = el.getAttribute('key');
fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(makeSubscribeBody(key))
});
});
};
function closeSubscriptions(keyArray) {
const actionArray = keyArray.map(key => {
channelMessageId++;
const subMsgId = activeSubIds[key];
delete activeSubIds[key];
return {
id: channelMessageId,
action: 'unsubscribe',
subscription: subMsgId
};
});
fetch(channelPath, {
method: 'PUT',
body: JSON.stringify(actionArray)
});
};
function makeSubscribeBody(subKey) {
channelMessageId++;
activeSubIds[subKey] = channelMessageId;
return [{
id: channelMessageId,
action: 'subscribe',
ship: ship,
app: gallApp,
path: `${baseSubPath}/${subKey}`
}];
};
function makePokeBody(jsonData) {
channelMessageId++;
return [{
id: channelMessageId,
action: 'poke',
ship: ship,
app: gallApp,
mark: 'json',
json: { pith: pith, data: jsonData }
}];
};
function makeAck(eventId) {
channelMessageId++
return [
{
id: channelMessageId,
action: 'ack',
'event-id': eventId
}
]
}

857
shrub/imp/mast.hoon Normal file
View File

@ -0,0 +1,857 @@
/@ ui-event
/@ mast-bind
/- su=shrub-utils
/* mast-js
=<
^- kook:neo
|%
++ state [%pro %sig]
++ poke (sy %mast-bind %eyre-task %eyre-chan-task %behn-res %gift %rely ~)
++ deps
%- ~(gas by *band:neo)
:~ :- %src
^- fief:neo
:- req=&
^- quay:neo
:- [pro/%sig ~]
^- (unit port:neo)
:+ ~ %y
%- ~(gas by *lads:neo)
:~ :- [|/%tas |]
`lash:neo`[only/%hoon ~]
==
==
++ kids
:+ ~ %y
%- my
:~ [[|/%ud |/%p |] [%pro %manx] (sy %ui-event %rely ~)]
==
++ form
^- form:neo
|_ [=bowl:neo =aeon:neo =pail:neo]
::
++ init
|= pal=(unit pail:neo)
^- (quip card:neo pail:neo)
~& > %mast-init
=| =rig
=/ =pith:neo #/[p/our.bowl]/$/eyre
=/ =binding:eyre [~ /mast]
=/ =req:eyre:neo [%connect binding ~(here moor our.bowl)]
:_ sig/!>(rig)
:~ [pith %poke eyre-req/!>(req)]
(behn-wait bowl)
==
::
++ poke
|= [sud=stud:neo vaz=vase]
^- (quip card:neo pail:neo)
:: ~& mast-poke/sud
=+ !<(=rig q.pail)
?+ sud !!
::
%mast-bind :: bind outside of sky
?> =(our.bowl ship.src.bowl)
=+ !<(bind=mast-bind vaz)
=/ =pith:neo #/[p/our.bowl]/$/eyre
=/ =binding:eyre [~ url.bind]
=/ =req:eyre:neo [%connect binding ~(here moor our.bowl)]
=/ =rope (mug bind)
=. endpoints.rig (~(put by endpoints.rig) url.bind [view.bind src.bind])
=. public.rig
?: public.bind
(~(put in public.rig) rope)
(~(del in public.rig) rope)
:_ sig/!>(rig)
:~ [pith %poke eyre-req/!>(req)]
==
::
%eyre-chan-task :: channel poke from the client
=+ !<(jon=json vaz)
=/ =crow (parse-channel-data jon)
=/ =boat ship.src.bowl
?- -.crow
::
%beat
=. last-beat.rig
=< q
%^ spin p.crow last-beat.rig
|= [i=rope a=last-beat]
^+ +<
[i (~(put by a) [i boat] now.bowl)]
[~ sig/!>(rig)]
::
%poke
:_ pail
:~ :- (~(session moor our.bowl) rope.crow boat)
[%poke ui-event/!>(`ui-event`[path.crow data.crow])]
==
::
==
::
%eyre-task :: session creation via http
=+ !<([rid=@ta req=inbound-request:eyre] vaz)
?. authenticated.req [(~(make-auth-redirect res bowl) rid) pail]
?+ method.request.req [(~(make-400 res bowl) rid) pail]
::
%'GET'
=/ url=path (stab url.request.req)
=/ =bind
?: ?=([%mast ^] url)
[i.t.url (pave:neo t.t.url)]
(~(got by endpoints.rig) url)
=/ =rope (mug bind)
=/ =boat ship.src.bowl
:: =/ lore q:(~(got by deps.bowl) %src)
:: =/ renderer=(unit pail:neo) (get-pail-saga-by-pith:su lore /[view.bind])
:: ?. ?| =(our.bowl boat)
:: (~(has in public.rig) rope)
:: ==
:: [(~(make-403 res bowl) rid) pail]
:: =/ has-renderer !=(~ renderer)
:: ~& > has-renderer/has-renderer
:: ?. has-renderer [(~(make-tree-redirect res bowl) rid src.bind) pail]
=/ at=pith:neo (~(session moor our.bowl) rope boat)
=/ =made:neo [view.bind ~ (my [%src src.bind] ~)]
=/ wat (~(get by waiting.rig) [rope boat])
=. waiting.rig
(~(put by waiting.rig) [rope boat] [rid ?~(wat ~ u.wat)])
:_ sig/!>(rig)
:~ [at %cull ~]
[at %make made]
==
::
==
::
%gift :: sail component updates
=/ rum=(list [=pith:neo =loot:neo]) ~(tap of:neo !<(gift:neo vaz))
=^ cards rig
=| cards=(list card:neo)
|- ^- (quip card:neo ^rig)
?~ rum
[cards rig]
=/ jig=(unit idea:neo) (~(get of:neo kids.bowl) pith.i.rum)
?~ jig
$(rum t.rum)
=/ =rope =/(ud (rear (snip pith.i.rum)) ?>(&(?=(^ ud) ?=(%ud -.ud)) +.ud))
=/ =boat =/(p (rear pith.i.rum) ?>(&(?=(^ p) ?=(%p -.p)) +.p))
=/ =buoy (mug [rope boat])
=/ =sail (hoist buoy rope boat !<(sail q.pail.u.jig))
=/ aft=(unit ^sail) (~(get by aft.rig) [rope boat])
?: =(%dif mode.loot.i.rum)
:: handle sail component diff
?~ aft
$(rum t.rum)
=/ sub=path (sub-path buoy)
=/ =diff (luff u.aft sail)
=^ imp-cards waiting.rig
(make-imps our.bowl boat p.diff [[buoy rope] ~] waiting.rig)
%= $
aft.rig (~(put by aft.rig) [rope boat] sail)
cards (welp cards ?~(q.diff imp-cards [(~(gust res bowl) sub [%a q.diff]) imp-cards]))
rum t.rum
==
:: handle sail component creation
=/ build-keys (~(got by waiting.rig) [rope boat])
=/ imp-els (find-imp-els sail)
=/ imp-ropes (turn imp-els |=(=bind (mug bind)))
=^ imp-cards waiting.rig
(make-imps our.bowl boat imp-els build-keys waiting.rig)
=: last-beat.rig (~(put by last-beat.rig) [rope boat] now.bowl)
waiting.rig (~(del by waiting.rig) [rope boat])
aft.rig (~(put by aft.rig) [rope boat] sail)
cards ?~(imp-cards cards (weld cards imp-cards))
==
|- ^- (quip card:neo ^rig)
?~ build-keys
^$(rum t.rum)
=/ buil (~(get by building.rig) i.build-keys)
?~ buil
?^ imp-els
%= $
build-keys t.build-keys
building.rig (~(put by building.rig) i.build-keys [(silt imp-ropes) sail])
==
%= $
build-keys t.build-keys
cards
%+ weld cards
?@ i.build-keys
(~(gale res bowl) i.build-keys sail)
[(~(gust res bowl) [(sub-path buoy.i.build-keys) (make-imp-gust sail)]) ~]
==
=: sail.u.buil (insert-imp-sail buoy sail.u.buil sail)
remaining.u.buil (~(del in remaining.u.buil) rope)
==
=? remaining.u.buil ?=(^ imp-ropes)
(~(gas in remaining.u.buil) imp-ropes)
?^ remaining.u.buil
%= $
build-keys t.build-keys
building.rig (~(put by building.rig) i.build-keys u.buil)
==
%= $
build-keys t.build-keys
building.rig (~(del by building.rig) i.build-keys)
cards
%+ weld cards
?@ i.build-keys
(~(gale res bowl) i.build-keys sail.u.buil)
[(~(gust res bowl) [(sub-path buoy.i.build-keys) (make-imp-gust sail.u.buil)]) ~]
==
[cards sig/!>(rig)]
::
%rely
~& >> %got-rely
`pail
::
%behn-res
(swab bowl rig)
::
==
::
--
--
::
|%
::
+$ crow :: client to mast channel poke data
$% [%beat p=(list rope)]
[%poke =rope =path data=(map @t @t)]
==
+$ view @tas :: view imp
+$ bind [=view src=pith:neo] :: view to src binding
+$ rope @ :: view+src bind id (mug bind)
+$ buoy @ :: channel subscription id (mug [rope boat])
+$ boat @p :: src ship session id
+$ sail manx
+$ diff (pair (list bind) (list json))
::
+$ waiting (map [rope boat] (list to-build)) :: sail component makes waiting to be handled
+$ building (map to-build [=remaining =sail]) :: sail component updates being built
+$ to-build $@(@ta [=buoy =rope]) :: eyre-id, or parent sail component's sub id and root's rope
+$ remaining (set rope) :: remaining nodes to complete a sail component update
+$ last-beat (map [rope boat] @da) :: last heartbeat timestamps per session
::
+$ rig :: mast state
$: =waiting
=building
=last-beat
endpoints=(map path bind) :: urls to view+src bindings (non-sky)
public=(set rope) :: view+src bindings served beyond =(ship.src our)
aft=(map [rope boat] sail) :: most recent sail state by session
==
::
++ mastimp-lifespan ~h12
++ cleanup-interval ~d1
::
++ moor :: assumes mast shrub location at /our-ship/mast
|_ our=@p
::
++ here
^- pith:neo
#/[p/our]/mast
::
++ session
|= [=rope =boat]
^- pith:neo
=/ here here
?> &(?=(^ here) ?=(^ t.here))
%_ here
t.t #/[ud/rope]/[p/boat]
==
::
--
::
++ sub-path
|= =buoy
^- path
/eyre-chan/mast/(crip (y-co:co buoy))
::
++ script-node
^- manx
;script: {(trip mast-js)}
::
++ parse-channel-data
|= jon=json
^- crow
?> ?& ?=(%a -.jon) ?=(^ p.jon)
?=([%s *] i.p.jon) ?=(^ t.p.jon)
==
?+ p.i.p.jon !!
%beat [%beat ((ar ni):dejs:format i.t.p.jon)]
%poke [%poke ((ot ~[rope+ni path+pa data+(om so)]):dejs:format i.t.p.jon)]
==
::
++ behn-wait
|= =bowl:neo
^- card:neo
=/ =pith:neo #/[p/our.bowl]/$/behn
[pith %poke %behn-req !>([%wait (add now.bowl cleanup-interval)])]
::
++ res
|_ =bowl:neo
::
++ gale :: send a full page
|= [rid=@ta =sail]
^- (list card:neo)
%^ make-direct-http-cards
rid
[200 ['Content-Type' 'text/html'] ~]
:- ~
^- octs
%- as-octt:mimes:html
%- en-xml:html
=/ =mart
:~ [%pith (en-tape:pith:neo ~(here moor our.bowl))]
[%ship +:(scow %p our.bowl)]
==
?. =(%html n.g.sail)
^- manx
:- [%html mart]
:~ [[%head ~] [script-node ~]]
?:(=(%body n.g.sail) sail [[%body ~] [sail ~]])
==
=/ i (get-el-index %head c.sail)
=/ hed=manx (snag i c.sail)
%_ sail
a.g (weld mart a.g.sail)
c (snap c.sail i hed(c (snoc c.hed script-node)))
==
::
++ gust :: send a diff update
|= [sub=path dif=json]
^- card:neo
:- #/[p/our.bowl]/$/eyre
:- %poke
:- %eyre-chan-gift
!> ^- chan-gift:eyre:neo
[sub dif]
::
++ make-400
|= rid=@ta
^- (list card:neo)
%^ make-direct-http-cards
rid
[400 ~]
~
::
++ make-403
|= rid=@ta
^- (list card:neo)
%^ make-direct-http-cards
rid
[403 ~]
~
::
++ make-auth-redirect
|= rid=@ta
^- (list card:neo)
%^ make-direct-http-cards
rid
[307 ['Location' '/~/login?redirect='] ~]
~
::
++ make-tree-redirect
|= [rid=@ta loc=pith]
^- (list card:neo)
%^ make-direct-http-cards
rid
[307 ['Location' (en-cord:pith:neo (welp /tree loc))] ~]
~
::
++ make-direct-http-cards
|= [rid=@ta hed=response-header:http dat=(unit octs)]
^- (list card:neo)
=/ eyre=pith:neo #/[p/our.bowl]/$/eyre
=/ head=sign:eyre:neo [rid %head hed]
=/ data=sign:eyre:neo [rid %data dat]
=/ done=sign:eyre:neo [rid %done ~]
:~ [eyre %poke eyre-sign/!>(head)]
[eyre %poke eyre-sign/!>(data)]
[eyre %poke eyre-sign/!>(done)]
==
::
--
::
++ swab :: session cleanup
|= [=bowl:neo =rig]
^- (quip card:neo pail:neo)
=^ dead=(set [rope boat]) last-beat.rig
%- %~ rep by last-beat.rig
|= $: i=(pair [rope boat] @da)
a=(pair (set [rope boat]) last-beat)
==
?: (lth (sub now.bowl q.i) mastimp-lifespan)
%_(a q (~(put by q.a) i))
%_(a p (~(put in p.a) p.i))
=. aft.rig
(malt (skip ~(tap by aft.rig) |=([i=[rope boat] *] (~(has in dead) i))))
=/ kill=(list card:neo)
%+ turn ~(tap in dead)
|= i=[rope boat]
^- card:neo
[(~(session moor our.bowl) i) %cull ~]
:_ sig/!>(rig)
[(behn-wait bowl) kill]
::
++ get-el-index
|= [n=@tas m=marl]
=| i=@
|- ^- @
?~ m ~|(missing-element/n !!)
?: =(n n.g.i.m) i
$(m t.m, i +(i))
::
++ find-imp-els
|= m=manx
=| acc=(list bind)
|- ^- (list bind)
?: ?& ?=([%imp @] n.g.m)
?=(^ c.m) ?=(^ a.g.i.c.m)
==
:_ acc
:- +.n.g.m
(pave:neo (stab (crip v.i.a.g.i.c.m)))
|- ^- (list bind)
?~ c.m acc
$(c.m t.c.m, acc ^$(m i.c.m))
::
++ make-imps
|= $: our=@p
=boat
bin=(list bind)
new=(list to-build)
wat=waiting
==
=| car=(list card:neo)
|- ^- (quip card:neo waiting)
?~ bin [car wat]
=/ =rope (mug i.bin)
=/ rest (~(get by wat) [rope boat])
=/ at=pith:neo (~(session moor our) rope boat)
%= $
bin t.bin
car
:+ [at %cull ~]
[at %make [view.i.bin ~ (my [%src src.i.bin] ~)]]
car
wat
(~(put by wat) [rope boat] ?~(rest new (weld new u.rest)))
==
::
++ prepare-imp-sail
|= m=manx
^- manx
?. =(%html n.g.m) m
=/ bod=manx (snag (get-el-index %body c.m) c.m)
bod(n.g %div)
::
++ make-imp-gust
|= m=manx
^- json
=. m (prepare-imp-sail m)
:- %a
:_ ~
:- %o
%- my
:~ ['p' [%s 'k']]
['q' [%s (getv %key a.g.m)]]
['r' [%s (crip (en-xml:html m))]]
==
::
++ insert-imp-sail
|= [=buoy par=manx imp=manx]
^- manx
=. imp (prepare-imp-sail imp)
=/ key=tape (y-co:co buoy)
?: ?& ?=([%imp @] n.g.par)
?=(^ (find [key/key ~] a.g.par))
==
imp
%_ par
c
|- ^- marl
?~ c.par ~
?: ?& ?=([%imp @] n.g.i.c.par)
?=(^ (find [key/key ~] a.g.i.c.par))
==
[imp t.c.par]
[i.c.par(c $(c.par c.i.c.par)) $(c.par t.c.par)]
==
::
++ prepare-root-mart
|= [=rope m=mart]
^- mart
:- [%rope (y-co:co rope)]
|- ^- mart
?~ m ~
?: |(=(%key n.i.m) =(%rope n.i.m))
$(m t.m)
[i.m $(m t.m)]
::
++ hoist :: process gifted sail
|_ [=buoy =rope =boat =sail]
++ $
^- manx
=/ root-key=tape (y-co:co buoy)
?. =(%html n.g.sail)
%+ anx
sail(a.g (prepare-root-mart rope a.g.sail))
[root-key ~]
=/ i=@ (get-el-index %body c.sail)
=/ bod=manx (snag i c.sail)
%_ sail
c
%^ snap
c.sail
i
%+ anx
bod(a.g (prepare-root-mart rope a.g.bod))
[root-key ~]
==
++ anx
|= [m=manx key=(pair tape (list @))]
^- manx
=/ fkey=@t (getv %key a.g.m)
=/ nkey=(pair tape (list @)) ?~(fkey key [((w-co:co 1) `@uw`(mug fkey)) ~])
=/ ntap=tape
?~ q.nkey p.nkey
(weld p.nkey ((w-co:co 1) `@uw`(jam q.nkey)))
?: ?& ?=([%imp @] n.g.m)
?=(^ c.m) ?=(^ a.g.i.c.m)
==
=/ =view +.n.g.m
=/ src=pith:neo (pave:neo (stab (crip v.i.a.g.i.c.m)))
=/ imp-rope (mug view src)
=/ imp-buoy (mug [imp-rope boat])
%_ m
a.g
:~ [%key (y-co:co imp-buoy)]
[%rope (y-co:co imp-rope)]
==
==
?: =(%$ n.g.m)
;t-
=key ntap
;+ m
==
%_ m
a.g
^- mart
?~ fkey
[[%key ntap] a.g.m]
a.g.m
c
?: ?| =(%input n.g.m) =(%textarea n.g.m)
=(%script n.g.m) =(%img n.g.m)
=(%link n.g.m) =(%hr n.g.m)
=(%meta n.g.m) =(%base n.g.m)
==
c.m
(arl c.m nkey)
==
++ arl
|= [m=marl key=(pair tape (list @))]
=| i=@
|- ^- marl
?~ m ~
:- %+ anx
i.m
key(q [i q.key])
$(m t.m, i +(i))
--
::
++ luff :: produce a sail diff for the client
|= [oldx=manx newx=manx]
=/ [old=marl new=marl]
:- ?. =(%html n.g.oldx)
[oldx ~]
[(snag (get-el-index %body c.oldx) c.oldx) ~]
?. =(%html n.g.newx)
[newx ~]
[(snag (get-el-index %body c.newx) c.newx) ~]
=| i=@ud
=| pkey=@t
=| acc=diff
|- ^- diff
?~ new
?~ old
acc
?: =(%skip- n.g.i.old)
%= $
old t.old
==
%_ acc
q
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'd']]
['q' [%a (turn old |=(m=manx [%s (getv %key a.g.m)]))]]
==
==
?: =(%$ n.g.i.new)
acc
?: &(?=(^ old) =(%skip- n.g.i.old))
%= $
old t.old
==
?: =(%move- n.g.i.new)
%= $
new t.new
i +(i)
q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s (getv %key a.g.i.new)]]
['r' [%n (getv %i a.g.i.new)]]
==
==
=| j=@ud
=/ jold=marl old
=/ nkey=[n=mane k=@t] [n.g.i.new (getv %key a.g.i.new)]
|- ^- diff
?~ new
!!
?~ jold
%= ^$
new t.new
i +(i)
p.acc
?. |(?=([%imp @] n.g.i.new) ?=(^ c.i.new))
p.acc
(weld p.acc (find-imp-els i.new))
q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s pkey]]
['r' [%n (scot %ud i)]]
['s' [%s (crip (en-xml:html i.new))]]
==
==
?~ old
!!
?: =(%skip- n.g.i.jold)
%= $
jold t.jold
j +(j)
==
?: =(nkey [n.g.i.jold (getv %key a.g.i.jold)])
?. =(0 j)
=| n=@ud
=/ nnew=marl new
=/ okey=[n=mane k=@t] [n.g.i.old (getv %key a.g.i.old)]
|- ^- diff
?~ nnew
%= ^^$
old (snoc t.old i.old)
==
?: =(%move- n.g.i.nnew)
%= $
nnew t.nnew
n +(n)
==
=/ nnky=[n=mane k=@t] [n.g.i.nnew (getv %key a.g.i.nnew)]
?. =(okey nnky)
%= $
nnew t.nnew
n +(n)
==
?: (gte n j)
=/ aupd (upda a.g.i.old a.g.i.nnew)
%= ^^$
old c.i.old
new c.i.nnew
pkey k.nnky
i 0
acc
%= ^^$
old t.old
new
%^ newm new n
;move-(i (y-co:co (add n i)), key (trip k.nnky));
q.acc
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nnky]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
=/ aupd (upda a.g.i.jold a.g.i.new)
%= ^^$
old c.i.jold
new c.i.new
pkey k.nkey
i 0
acc
%= ^^$
old (newm old j ;skip-;)
new t.new
i +(i)
q.acc
=. q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s k.nkey]]
['r' [%n (scot %ud i)]]
==
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nkey]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
?: =(%t- n.g.i.new)
?: ?& ?=(^ c.i.old) ?=(^ c.i.new)
?=(^ a.g.i.c.i.old) ?=(^ a.g.i.c.i.new)
=(v.i.a.g.i.c.i.old v.i.a.g.i.c.i.new)
==
%= ^$
old t.old
new t.new
i +(i)
==
=/ txt=@t
?. &(?=(^ c.i.new) ?=(^ a.g.i.c.i.new))
''
(crip v.i.a.g.i.c.i.new)
%= ^$
old t.old
new t.new
i +(i)
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 't']]
['q' [%s (getv %key a.g.i.new)]]
['r' [%s txt]]
==
==
=/ aupd (upda a.g.i.old a.g.i.new)
%= ^$
old c.i.old
new c.i.new
pkey k.nkey
i 0
acc
%= ^$
old t.old
new t.new
i +(i)
q.acc
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nkey]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
%= $
jold t.jold
j +(j)
==
::
++ getv
|= [t=@tas m=mart]
^- @t
?~ m ''
?: =(n.i.m t)
(crip v.i.m)
$(m t.m)
::
++ upda :: produce an attribute list diff
|= [om=mart nm=mart]
=| acc=[del=(list json) new=(list json)]
|- ^+ acc
?~ nm
?~ om
acc
%_ acc
del
%+ turn om
|= [n=mane *]
[%s `@t`?>(?=(@ n) n)]
==
=| i=@ud
=/ com=mart om
|- ^+ acc
?~ nm
!!
?~ com
%= ^$
nm t.nm
new.acc
:_ new.acc
:- %a
:~ [%s `@t`?>(?=(@ n.i.nm) n.i.nm)]
[%s (crip v.i.nm)]
==
==
?~ om
!!
?: =(n.i.com n.i.nm)
?: =(v.i.com v.i.nm)
%= ^$
om (oust [i 1] (mart om))
nm t.nm
==
%= ^$
om (oust [i 1] (mart om))
nm t.nm
new.acc
:_ new.acc
:- %a
:~ [%s `@t`?>(?=(@ n.i.nm) n.i.nm)]
[%s (crip v.i.nm)]
==
==
%= $
com t.com
i +(i)
==
::
++ newm
|= [ml=marl i=@ud mx=manx]
=| j=@ud
|- ^- marl
?~ ml
~
:- ?: =(i j)
mx
i.ml
$(ml t.ml, j +(j))
::
--

741
shrub/tests/mast.hoon Normal file
View File

@ -0,0 +1,741 @@
/- neo
/+ *test
=<
|%
::
:: MAST TESTS
::
:: - the diff algorithm in ++luff works on a child-list by child-list basis,
:: which accumulates accross the tree,
:: so tests for each diff operation only need to pertain to a single child list.
::
:: - adding an explicit key attribute causes a difference in the diff product insofar as
:: identity is able to track independently of location
:: (hoist adds implicit location based keys in the absence of explicit ones),
:: but from the perspective of the diff algorithm,
:: there isn't a distinction between an explicit key attribute or a locational one;
:: elements always have keys which constitute the identities of the elements.
:: so testing this difference would be redundant.
:: all tests will involve explicit keys because this enables testing the full range of cases.
::
:: - the diff is represented in +$json as an array containing the various diff operations.
:: - top level: []
:: - new/add: { p: "n", q: "parent-key", r: index-num, s: "node-html" }
:: - delete: { p: "d", q: ["node-key", "node-key", ....]}
:: - move: { p: "m", q: "node-key", r: index-num }
:: - attribute change: { p: "c", q: "node-key", r: [attr-name-to-remove, ...], s: [["new-attr-name", "new-attr-value"], ...] }
:: - text change: { p: "t", q: "text-container-key", r: "text to replace in the text node within the container" }
:: - component swap: { p: "k", q: "component-root-key", r: "node-html" }
::
:: - the component swap case is not a product of the diff algorithm,
:: however, ++luff produces a list of component data from any new component element found,
:: so this will be tested.
::
::
++ sail--base
^- manx
;test(key "test")
;a(key "test-a", class "a"): test a
;b(key "test-b", class "b"): test b
;c(key "test-c", class "c"): test c
;d(key "test-d", class "d"): test d
==
::
++ sail--add
^- manx
=/ base sail--base
=/ new=manx ;new-element(key "new-element");
%_ base
c (into c.base 2 new)
==
::
++ test--diff--add
%+ expect-eq
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s 'test']]
['r' [%n ~.2]]
['s' [%s (crip (en-xml:html `manx`;new-element(key "new-element");))]]
==
::
!> (luff (diff-sample sail--base sail--add))
::
++ sail--delete
^- manx
=/ base sail--base
%_ base
c (oust [2 1] c.base)
==
::
++ test--diff--delete
%+ expect-eq
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'd']]
['q' [%a ~[[%s 'test-c']]]]
==
::
!> (luff (diff-sample sail--base sail--delete))
::
++ sail--move
^- manx
=/ base sail--base
=/ el=manx (snag 2 c.base)
=. c.base (oust [2 1] c.base)
%_ base
c [el c.base]
==
::
++ test--diff--move
%+ expect-eq
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s 'test-c']]
['r' [%n ~.0]]
==
::
!> (luff (diff-sample sail--base sail--move))
::
++ sail--attribute-add
^- manx
=/ base sail--base
=/ el=manx (snag 2 c.base)
=. a.g.el [[%new "attribute"] a.g.el]
%_ base
c (snap c.base 2 el)
==
::
++ test--diff--attribute-add
%+ expect-eq
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s 'test-c']]
['r' [%a ~]]
['s' [%a ~[[%a ~[[%s 'new'] [%s 'attribute']]]]]]
==
::
!> (luff (diff-sample sail--base sail--attribute-add))
::
++ sail--attribute-delete
^- manx
=/ base sail--base
=/ el=manx (snag 2 c.base)
=. a.g.el (snip a.g.el)
%_ base
c (snap c.base 2 el)
==
::
++ test--diff--attribute-delete
%+ expect-eq
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s 'test-c']]
['r' [%a ~[[%s 'class']]]]
['s' [%a ~]]
==
::
!> (luff (diff-sample sail--base sail--attribute-delete))
::
++ sail--text-change
^- manx
=/ base sail--base
=/ el=manx (snag 2 c.base)
?> &(?=(^ c.el) ?=(%$ n.g.i.c.el) ?=(^ a.g.i.c.el))
=. v.i.a.g.i.c.el "new text"
%_ base
c (snap c.base 2 `manx`el)
==
::
++ test--diff--text-change
%+ expect-eq
::
=/ new=manx (apply-hoist sail--text-change)
=/ el=manx (snag 2 c.new)
?> ?& ?=(^ c.el)
?=(^ a.g.i.c.el)
?=(%key n.i.a.g.i.c.el)
==
=/ key (crip v.i.a.g.i.c.el)
::
!>
^- diff
:- ~
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 't']]
['q' [%s key]]
['r' [%s 'new text']]
==
::
!> (luff (diff-sample sail--base sail--text-change))
::
++ sail--component
^- manx
=/ base sail--base
=/ new=manx ;imp_component: /test/pith
%_ base
c (into c.base 2 new)
==
::
++ test--diff--component
%+ expect-eq
::
!>
^- diff
:- ~[[%component `pith:neo`/test/pith]]
^- (list json)
:_ ~
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s 'test']]
['r' [%n ~.2]]
['s' [%s (crip (en-xml:html (apply-hoist ;imp_component:"/test/pith")))]]
==
::
!> (luff (diff-sample sail--base sail--component))
::
++ sail--assortment
^- manx
=/ base sail--base
:: delete ;a;
=. c.base (oust [0 1] c.base)
:: add ;e; to the end
=. c.base
%+ snoc c.base
^- manx
;e(key "test-e", class "e"): test e
:: move ;c; below ;e; and give it a new attribute
=/ el-c=manx (snag 1 c.base)
=. a.g.el-c (snoc a.g.el-c [%new "attribute"])
=. c.base (oust [1 1] c.base)
=. c.base (snoc c.base el-c)
:: change the text node in ;b;
=/ el-b=manx (snag 0 c.base)
?> &(?=(^ c.el-b) ?=(%$ n.g.i.c.el-b) ?=(^ a.g.i.c.el-b))
=. v.i.a.g.i.c.el-b "new text"
=. c.base (snap c.base 0 `manx`el-b)
:: add a component to the beginning
=. c.base [`manx`;imp_component:"/test/pith" c.base]
base
::
++ test--diff--assortment
%+ expect-eq
::
=/ new=manx (apply-hoist sail--assortment)
=/ el-b=manx (snag 1 c.new)
?> ?& ?=(^ c.el-b)
?=(^ a.g.i.c.el-b)
?=(%key n.i.a.g.i.c.el-b)
==
=/ key-b-txt (crip v.i.a.g.i.c.el-b)
=/ el-e=manx (snag 3 c.new)
::
!>
^- diff
:- ~[[%component `pith:neo`/test/pith]]
^- (list json)
:~ :- %o
%- my
:~ ['p' [%s 't']]
['q' [%s key-b-txt]]
['r' [%s 'new text']]
==
::
:- %o
%- my
:~ ['p' [%s 'd']]
['q' [%a ~[[%s 'test-a']]]]
==
::
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s 'test-c']]
['r' [%a ~]]
['s' [%a ~[[%a ~[[%s 'new'] [%s 'attribute']]]]]]
==
::
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s 'test']]
['r' [%n ~.0]]
['s' [%s (crip (en-xml:html (apply-hoist ;imp_component:"/test/pith")))]]
==
::
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s 'test']]
['r' [%n ~.3]]
['s' [%s (crip (en-xml:html el-e))]]
==
::
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s 'test-c']]
['r' [%n ~.04]] :: 0 because printed with y-co:co ...
==
==
::
!> (luff (diff-sample sail--base sail--assortment))
:: :: :: :: ::
++ apply-hoist
|= m=manx
^- manx
(~(anx hoist 0 0 *@p m) m ~ ~)
::
++ diff-sample
|= [old=manx new=manx]
^- [manx manx]
[(apply-hoist old) (apply-hoist new)]
::
--
:: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: ::
:: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: ::
:: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: :: ::
|%
::
+$ view @tas :: view imp
+$ bind [=view src=pith:neo] :: view to src binding
+$ rope @ :: view+src bind id (mug bind)
+$ buoy @ :: channel subscription id (mug [rope boat])
+$ boat @p :: src ship session id
+$ sail manx
+$ diff (pair (list bind) (list json))
::
++ hoist :: process sail
|_ [=buoy =rope =boat =sail]
++ $
^- manx
=/ root-key=tape (y-co:co buoy)
?. =(%html n.g.sail)
%+ anx
sail(a.g (prepare-root-mart rope a.g.sail))
[root-key ~]
=/ i=@ (get-el-index %body c.sail)
=/ bod=manx (snag i c.sail)
%_ sail
c
%^ snap
c.sail
i
%+ anx
bod(a.g (prepare-root-mart rope a.g.bod))
[root-key ~]
==
++ anx
|= [m=manx key=(pair tape (list @))]
^- manx
=/ fkey=@t (getv %key a.g.m)
=/ nkey=(pair tape (list @)) ?~(fkey key [((w-co:co 1) `@uw`(mug fkey)) ~])
=/ ntap=tape
?~ q.nkey p.nkey
(weld p.nkey ((w-co:co 1) `@uw`(jam q.nkey)))
?: ?& ?=([%imp @] n.g.m)
?=(^ c.m) ?=(^ a.g.i.c.m)
==
=/ =view +.n.g.m
=/ src=pith:neo (pave:neo (stab (crip v.i.a.g.i.c.m)))
=/ imp-rope (mug view src)
=/ imp-buoy (mug [imp-rope boat])
%_ m
a.g
:~ [%key (y-co:co imp-buoy)]
[%rope (y-co:co imp-rope)]
==
==
?: =(%$ n.g.m)
;t-
=key ntap
;+ m
==
%_ m
a.g
^- mart
?~ fkey
[[%key ntap] a.g.m]
a.g.m
c
?: ?| =(%input n.g.m) =(%textarea n.g.m)
=(%script n.g.m) =(%img n.g.m)
=(%link n.g.m) =(%hr n.g.m)
=(%meta n.g.m) =(%base n.g.m)
==
c.m
(arl c.m nkey)
==
++ arl
|= [m=marl key=(pair tape (list @))]
=| i=@
|- ^- marl
?~ m ~
:- %+ anx
i.m
key(q [i q.key])
$(m t.m, i +(i))
--
::
++ luff :: produce a sail diff
|= [oldx=manx newx=manx]
=/ [old=marl new=marl]
:- ?. =(%html n.g.oldx)
[oldx ~]
[(snag (get-el-index %body c.oldx) c.oldx) ~]
?. =(%html n.g.newx)
[newx ~]
[(snag (get-el-index %body c.newx) c.newx) ~]
=| i=@ud
=| pkey=@t
=| acc=diff
|- ^- diff
?~ new
?~ old
acc
?: =(%skip- n.g.i.old)
%= $
old t.old
==
%_ acc
q
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'd']]
['q' [%a (turn old |=(m=manx [%s (getv %key a.g.m)]))]]
==
==
?: =(%$ n.g.i.new)
acc
?: &(?=(^ old) =(%skip- n.g.i.old))
%= $
old t.old
==
?: =(%move- n.g.i.new)
%= $
new t.new
i +(i)
q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s (getv %key a.g.i.new)]]
['r' [%n (getv %i a.g.i.new)]]
==
==
=| j=@ud
=/ jold=marl old
=/ nkey=[n=mane k=@t] [n.g.i.new (getv %key a.g.i.new)]
|- ^- diff
?~ new
!!
?~ jold
%= ^$
new t.new
i +(i)
p.acc
?. |(?=([%imp @] n.g.i.new) ?=(^ c.i.new))
p.acc
(weld p.acc (find-imp-els i.new))
q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'n']]
['q' [%s pkey]]
['r' [%n (scot %ud i)]]
['s' [%s (crip (en-xml:html i.new))]]
==
==
?~ old
!!
?: =(%skip- n.g.i.jold)
%= $
jold t.jold
j +(j)
==
?: =(nkey [n.g.i.jold (getv %key a.g.i.jold)])
?. =(0 j)
=| n=@ud
=/ nnew=marl new
=/ okey=[n=mane k=@t] [n.g.i.old (getv %key a.g.i.old)]
|- ^- diff
?~ nnew
%= ^^$
old (snoc t.old i.old)
==
?: =(%move- n.g.i.nnew)
%= $
nnew t.nnew
n +(n)
==
=/ nnky=[n=mane k=@t] [n.g.i.nnew (getv %key a.g.i.nnew)]
?. =(okey nnky)
%= $
nnew t.nnew
n +(n)
==
?: (gte n j)
=/ aupd (upda a.g.i.old a.g.i.nnew)
%= ^^$
old c.i.old
new c.i.nnew
pkey k.nnky
i 0
acc
%= ^^$
old t.old
new
%^ newm new n
;move-(i (y-co:co (add n i)), key (trip k.nnky));
q.acc
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nnky]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
=/ aupd (upda a.g.i.jold a.g.i.new)
%= ^^$
old c.i.jold
new c.i.new
pkey k.nkey
i 0
acc
%= ^^$
old (newm old j ;skip-;)
new t.new
i +(i)
q.acc
=. q.acc
%+ snoc q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'm']]
['q' [%s k.nkey]]
['r' [%n (scot %ud i)]]
==
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nkey]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
?: =(%t- n.g.i.new)
?: ?& ?=(^ c.i.old) ?=(^ c.i.new)
?=(^ a.g.i.c.i.old) ?=(^ a.g.i.c.i.new)
=(v.i.a.g.i.c.i.old v.i.a.g.i.c.i.new)
==
%= ^$
old t.old
new t.new
i +(i)
==
=/ txt=@t
?. &(?=(^ c.i.new) ?=(^ a.g.i.c.i.new))
''
(crip v.i.a.g.i.c.i.new)
%= ^$
old t.old
new t.new
i +(i)
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 't']]
['q' [%s (getv %key a.g.i.new)]]
['r' [%s txt]]
==
==
=/ aupd (upda a.g.i.old a.g.i.new)
%= ^$
old c.i.old
new c.i.new
pkey k.nkey
i 0
acc
%= ^$
old t.old
new t.new
i +(i)
q.acc
?: &(?=(~ del.aupd) ?=(~ new.aupd))
q.acc
:_ q.acc
^- json
:- %o
%- my
:~ ['p' [%s 'c']]
['q' [%s k.nkey]]
['r' [%a del.aupd]]
['s' [%a new.aupd]]
==
==
==
%= $
jold t.jold
j +(j)
==
::
++ getv
|= [t=@tas m=mart]
^- @t
?~ m ''
?: =(n.i.m t)
(crip v.i.m)
$(m t.m)
::
++ upda :: produce an attribute list diff
|= [om=mart nm=mart]
=| acc=[del=(list json) new=(list json)]
|- ^+ acc
?~ nm
?~ om
acc
%_ acc
del
%+ turn om
|= [n=mane *]
[%s `@t`?>(?=(@ n) n)]
==
=| i=@ud
=/ com=mart om
|- ^+ acc
?~ nm
!!
?~ com
%= ^$
nm t.nm
new.acc
:_ new.acc
:- %a
:~ [%s `@t`?>(?=(@ n.i.nm) n.i.nm)]
[%s (crip v.i.nm)]
==
==
?~ om
!!
?: =(n.i.com n.i.nm)
?: =(v.i.com v.i.nm)
%= ^$
om (oust [i 1] (mart om))
nm t.nm
==
%= ^$
om (oust [i 1] (mart om))
nm t.nm
new.acc
:_ new.acc
:- %a
:~ [%s `@t`?>(?=(@ n.i.nm) n.i.nm)]
[%s (crip v.i.nm)]
==
==
%= $
com t.com
i +(i)
==
::
++ newm
|= [ml=marl i=@ud mx=manx]
=| j=@ud
|- ^- marl
?~ ml
~
:- ?: =(i j)
mx
i.ml
$(ml t.ml, j +(j))
::
++ get-el-index
|= [n=@tas m=marl]
=| i=@
|- ^- @
?~ m ~|(missing-element/n !!)
?: =(n n.g.i.m) i
$(m t.m, i +(i))
::
++ find-imp-els
|= m=manx
=| acc=(list bind)
|- ^- (list bind)
?: ?& ?=([%imp @] n.g.m)
?=(^ c.m) ?=(^ a.g.i.c.m)
==
:_ acc
:- +.n.g.m
(pave:neo (stab (crip v.i.a.g.i.c.m)))
|- ^- (list bind)
?~ c.m acc
$(c.m t.c.m, acc ^$(m i.c.m))
::
++ prepare-root-mart
|= [=rope m=mart]
^- mart
:- [%rope (y-co:co rope)]
|- ^- mart
?~ m ~
?: |(=(%key n.i.m) =(%rope n.i.m))
$(m t.m)
[i.m $(m t.m)]
::
--