{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Wrapper where
import Text.RawString.QQ (r)
import Data.Text (Text)
data HtmlEventHandler = HtmlEventHandler
{ HtmlEventHandler -> Text
eventType :: Text
, HtmlEventHandler -> Text
functionName :: Text
, HtmlEventHandler -> Text
handlingFunction :: Text
}
clickEventHandlingFunction :: Text
clickEventHandlingFunction :: Text
clickEventHandlingFunction = [r|
function handleClickEvents(event) {
event.stopPropagation();
var clickValue;
try {
clickValue = JSON.parse(event.target.getAttribute("action"));
} catch (error) {
// if the action is just a string, parsing it as JSON would fail
clickValue = event.target.getAttribute("action");
}
var location = JSON.parse(event.currentTarget.getAttribute("handler"))
if (clickValue) {
window.ws.send(JSON.stringify({ "event": "click", "message": clickValue, "location": location }));
}
}
|]
clickEventHandler :: HtmlEventHandler
clickEventHandler :: HtmlEventHandler
clickEventHandler = Text -> Text -> Text -> HtmlEventHandler
HtmlEventHandler Text
"click" Text
"handleClickEvents" Text
clickEventHandlingFunction
submitEventHandlingFunction :: Text
submitEventHandlingFunction :: Text
submitEventHandlingFunction = [r|
function handleFormEvents(event) {
event.preventDefault();
event.stopPropagation();
var form = new FormData(event.target);
var entries = Object.fromEntries(form.entries());
var location = JSON.parse(event.currentTarget.getAttribute("handler"))
if (entries) {
window.ws.send(JSON.stringify({ "event": "submit", "message": entries, "location": location }));
}
}
|]
submitEventHandler :: HtmlEventHandler
submitEventHandler :: HtmlEventHandler
submitEventHandler = Text -> Text -> Text -> HtmlEventHandler
HtmlEventHandler Text
"submit" Text
"handleFormEvents" Text
submitEventHandlingFunction
defaultHtmlEventHandlers :: [HtmlEventHandler]
defaultHtmlEventHandlers :: [HtmlEventHandler]
defaultHtmlEventHandlers =
[ HtmlEventHandler
clickEventHandler
, HtmlEventHandler
submitEventHandler
]
mkBinding :: HtmlEventHandler -> Text
mkBinding :: HtmlEventHandler -> Text
mkBinding (HtmlEventHandler Text
kind Text
functionName Text
_) =
Text
"item.removeEventListener(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kind Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
functionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
");"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"item.addEventListener(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
kind Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
functionName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
");"
mkFunction :: HtmlEventHandler -> Text
mkFunction :: HtmlEventHandler -> Text
mkFunction (HtmlEventHandler Text
_ Text
_ Text
function) = Text
function
bindEvents :: [HtmlEventHandler] -> Text
bindEvents :: [HtmlEventHandler] -> Text
bindEvents [HtmlEventHandler]
htmlEventHandlers =
let bindings :: Text
bindings = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (HtmlEventHandler -> Text) -> [HtmlEventHandler] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HtmlEventHandler -> Text
mkBinding [HtmlEventHandler]
htmlEventHandlers
functions :: Text
functions = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (HtmlEventHandler -> Text) -> [HtmlEventHandler] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HtmlEventHandler -> Text
mkFunction [HtmlEventHandler]
htmlEventHandlers
in
Text
functions
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"function bindEvents() {"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"document.querySelectorAll(\"[handler]\").forEach(item => {"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bindings
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"});"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"};"
websocketScript :: Text
websocketScript :: Text
websocketScript = [r|
var timeoutTime = -50;
function connect() {
timeoutTime += 50;
var ws = new WebSocket("ws://localhost:8001");
ws.onopen = () => {
ws.send("initial from js");
timeoutTime = 0;
};
ws.onmessage = evt => {
var m = evt.data;
console.log( m );
console.log(JSON.parse( m ));
var event = JSON.parse(evt.data);
if (event.event === "setHtml") {
// cool enough for now
event.message.map(command => setHtml(command));
bindEvents();
}
};
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);
targetNode.outerHTML = newHtml;
}
|]
wrapHtml :: Text -> [HtmlEventHandler] -> Text -> Text
wrapHtml :: Text -> [HtmlEventHandler] -> Text -> Text
wrapHtml Text
htmlHead [HtmlEventHandler]
htmlEventHandlers Text
body =
Text
"<html>"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<head>"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<script>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
websocketScript Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [HtmlEventHandler] -> Text
bindEvents [HtmlEventHandler]
htmlEventHandlers Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"bindEvents();" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</script>"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
htmlHead
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</head>"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<body>"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
body Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</body>"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</html>"