{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Wrapper where
import Text.RawString.QQ (r)
eventHandlerFn :: String
eventHandlerFn :: [Char]
eventHandlerFn = [Char]
[r|
function eventHandler(event) {
event.stopPropagation();
const type = event.type;
// ie "click-location" or "blur-location"
const locationCheck = `${type}-location`;
const possibleLocation = event.target.getAttribute(locationCheck);
if (possibleLocation) {
const childLocation = JSON.parse(possibleLocation)
if (type === "submit") {
event.preventDefault();
var form = new FormData(event.target);
var entries = JSON.stringify(Object.fromEntries(form.entries()));
var location = JSON.parse(event.currentTarget.getAttribute("handler"));
window.ws.send(JSON.stringify({
"event": "submit",
"value": entries,
"childLocation": childLocation,
"location": location
}));
} else {
var value = event.target.value;
var location = JSON.parse(event.currentTarget.getAttribute("handler"))
var wrappedValue = typeof value === 'string' ? value : `${value}`;
window.ws.send(JSON.stringify({
"event": type,
"value": wrappedValue,
"childLocation": childLocation,
"location": location
}));
}
}
}
|]
bindEventsFn :: String
bindEventsFn :: [Char]
bindEventsFn = [Char]
[r|
function bindEvents() {
document.querySelectorAll("[handler]").forEach(item => {
if (!item.getAttribute("bound")) {
events.map(event => {
item.addEventListener(event, eventHandler)
})
item.setAttribute("bound", "true")
}
})
}
|]
eventHandling :: [String] -> String
eventHandling :: [[Char]] -> [Char]
eventHandling [[Char]]
eventsList =
let eventsToWatch :: [Char]
eventsToWatch = [Char]
"const events = " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
eventsList
in [Char]
eventsToWatch [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
eventHandlerFn [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
bindEventsFn
eventBubblingHandling :: String
eventBubblingHandling :: [Char]
eventBubblingHandling = [Char]
[r|
function bindLocationEnrichment() {
document.querySelectorAll("[bubbling-bound]").forEach(item => {
const alreadyBound = item.getAttribute('bubbling-bound')
if (!alreadyBound) {
events.map(event => {
const eventLocation = item.getAttribute(`${event}-location`)
if (eventLocation) {
item.addEventListener(event, eventFromDOM => {
eventFromDOM.target.setAttribute(`${event}-location`, eventLocation)
})
}
})
item.setAttribute('bubbling-bound', true)
}
})
}
|]
websocketScript :: Bool -> String
websocketScript :: Bool -> [Char]
websocketScript Bool
secure =
let connectionPath :: [Char]
connectionPath = if Bool
secure
then [Char]
"var ws = new WebSocket('wss://' + window.location.host + window.location.pathname);"
else [Char]
"var ws = new WebSocket('ws://' + window.location.host + window.location.pathname);"
in
[Char]
connectionPath [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
[r|
var timeoutTime = -50;
function connect() {
timeoutTime += 50;
// TODO: adding the current path is kind of a hack
ws.onopen = () => {
timeoutTime = 0;
};
ws.onmessage = evt => {
var m = evt.data;
var event = JSON.parse(evt.data);
if (event.event === "setHtml") {
// cool enough for now
event.message.map(command => setHtml(command));
bindEvents();
bindLocationEnrichment();
} else if (event.event === "callJS") {
const [fnToCall, withValue] = event.message;
window[fnToCall](withValue);
} else if (event.event === "setCSS") {
var sheet = window.document.styleSheets[0];
event.message.map(cssRule => {
const [name, css] = cssRule;
sheet.insertRule('.' + name + '{ ' + css + ' }', sheet.cssRules.length);
})
}
};
ws.onclose = function() {
setTimeout(function() {
console.debug("Attempting to reconnect");
connect();
}, timeoutTime);
};
window.onbeforeunload = evt => {
ws.close();
};
window.ws = ws;
}
connect();
function getNode(location) {
let currentNode = document.body;
while (location.length > 0) {
const index = location.pop();
currentNode = currentNode.childNodes[index];
}
return currentNode;
}
function setHtml(message) {
const command = message.message;
const [location, newHtml] = message.contents;
const targetNode = getNode(location);
// hacky fix for https://github.com/purview-framework/purview/issues/123
if (targetNode.tagName === "BODY") {
targetNode.innerHTML = newHtml;
} else {
targetNode.outerHTML = newHtml;
}
}
|]
sendEventHelper :: String
sendEventHelper :: [Char]
sendEventHelper = [Char]
[r|
const sendEvent = (receiverName, value) => {
const targets = document.querySelectorAll("[receiver-name=" + receiverName + "]")
if (targets.length > 1) {
console.error("too many")
} else if (targets.length == 0) {
console.error("none found")
} else {
var target = targets[0]
var location = JSON.parse(target.getAttribute("parent-handler"))
var childLocation = JSON.parse(target.getAttribute("handler"))
window.ws.send(JSON.stringify({
"event": "submit",
"value": value,
"childLocation": childLocation,
"location": location
}));
}
}
|]
prepareCss :: [(String, String)] -> String
prepareCss :: [([Char], [Char])] -> [Char]
prepareCss = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\([Char]
hash, [Char]
css) -> [Char]
"." [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
hash [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" {" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
css [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}\n")
wrapHtml
:: [(String, String)]
-> String
-> [String]
-> String
-> Bool
-> String
-> String
wrapHtml :: [([Char], [Char])]
-> [Char] -> [[Char]] -> [Char] -> Bool -> [Char] -> [Char]
wrapHtml [([Char], [Char])]
css [Char]
htmlHead [[Char]]
eventsToListenTo [Char]
javascript Bool
secure [Char]
body =
[Char]
"<!DOCTYPE html>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<html>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<head>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
htmlHead
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Bool -> [Char]
websocketScript Bool
secure
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [[Char]] -> [Char]
eventHandling [[Char]]
eventsToListenTo
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
eventBubblingHandling
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
sendEventHelper
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
javascript
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<style>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [([Char], [Char])] -> [Char]
prepareCss [([Char], [Char])]
css
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</style>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</head>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<body>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
body
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"<script>bindEvents(); bindLocationEnrichment();</script>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</body>"
[Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"</html>"