packages feed

jsaddle-webview2 (empty) → 0.1.0.0

raw patch · 8 files changed

+968/−0 lines, 8 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, data-default, jsaddle, jsaddle-webview2, text

Files

+ ChangeLog.md view
@@ -0,0 +1,11 @@+# Revision history for jsaddle-webview2++## 0.1.0.0++* First release.  Hosts a jsaddle app in a native Win32 window containing+  a Microsoft Edge WebView2 control: the Windows sibling of+  jsaddle-wkwebview (macOS/iOS) and jsaddle-webkitgtk (Linux).+* The host window's HWND is exposed, for native menus and dialogs.+* Building needs WebView2.h from the Microsoft.Web.WebView2 NuGet package+  (see README.md); running needs the WebView2 runtime and+  WebView2Loader.dll next to the executable.
+ LICENSE view
@@ -0,0 +1,21 @@+Copyright (c) 2010-2012 Hamish Mackenzie, Victor Nazarov, Luite Stegeman++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+
+ README.md view
@@ -0,0 +1,83 @@+# jsaddle-webview2++Run [jsaddle](../jsaddle) apps in a native Windows window hosting a Microsoft+Edge **WebView2** control — the Windows sibling of+[jsaddle-wkwebview](../jsaddle-wkwebview) (macOS/iOS, WebKit) and+[jsaddle-webkit2gtk](../jsaddle-webkit2gtk) (Linux, WebKitGTK).++```haskell+import qualified Language.Javascript.JSaddle.WebView2 as WV2++main :: IO ()+main = WV2.run myJsmApp+```++## How it works++The C shim (`cbits/WebView2Shim.c`, plain C COM against the official+`WebView2.h`) creates a Win32 window, loads `WebView2Loader.dll` dynamically,+creates the WebView2 environment/controller, and pumps the message loop.+The jsaddle transport mirrors jsaddle-wkwebview exactly:++* **Haskell → JS**: batches are `ExecuteScript`ed (marshalled to the UI+  thread with `PostMessage`, since WebView2 is single-threaded).+* **JS → Haskell (async)**: `window.chrome.webview.postMessage(...)` →+  `WebMessageReceived`.+* **JS → Haskell (sync)**: `window.prompt("JSaddleSync", <json>)`.  Default+  script dialogs are disabled, so the `ScriptDialogOpening` event fires on+  the UI thread while the page's JS is blocked in `prompt()`; the handler+  calls into Haskell, which computes the reply batch, and completes the+  dialog with `put_ResultText` + `Accept`.  (Same trick as wkwebview's+  `runJavaScriptTextInputPanelWithPrompt` — which is why the WKWebView+  `uiDelegate` must never be overridden there, and why default script+  dialogs must stay disabled here.)++## Build requirements++Only `WebView2.h` (and the headers it includes) is needed at **compile**+time; nothing from the WebView2 SDK is linked.  Get it from the+[`Microsoft.Web.WebView2`](https://www.nuget.org/packages/Microsoft.Web.WebView2)+NuGet package (it's a plain zip): `build/native/include/WebView2.h`.+Point the include path at it, e.g. in `cabal.project`:++```+package jsaddle-webview2+  extra-include-dirs: C:\path\to\webview2-sdk\build\native\include+```++With nix, a small `fetchzip` derivation does it (license: unfree but+freely redistributable):++```nix+webview2-sdk = pkgs.fetchzip {+  url = "https://www.nuget.org/api/v2/package/Microsoft.Web.WebView2/1.0.4022.49";+  extension = "zip";+  stripRoot = false;+  hash = "...";+};+# then: extra-include-dirs = [ "${webview2-sdk}/build/native/include" ];+```++The header is MIDL-generated flat COM and compiles fine under **mingw-w64**+(GHC's Windows toolchain) — no MSVC needed.++## Runtime requirements++* The **WebView2 runtime** — preinstalled on Windows 11, Evergreen-installed+  on most Windows 10 machines ([bootstrapper](https://developer.microsoft.com/microsoft-edge/webview2/)+  for the rest).+* **`WebView2Loader.dll`** next to the executable — from the same NuGet+  package (`runtimes/win-x64/native/WebView2Loader.dll`).  It is+  `LoadLibrary`'d at startup, so no import library is needed at link time.++## Notes and limitations++* `runHTML` uses `NavigateToString`: page origin is `about:blank` and the+  HTML is capped at 2MB.  Use `runURL` (e.g. a `file://` URL or+  `SetVirtualHostNameToFolderMapping` in a future version) for real apps.+* Page reloads are not supported (jsaddle state does not survive them);+  only the first completed navigation starts the jsaddle app.+* The user-data folder defaults to `%LOCALAPPDATA%\jsaddle-webview2`.+* The sync bridge rides `window.prompt`, so apps must not intercept+  `ScriptDialogOpening` themselves, and very large sync payloads depend on+  Chromium passing dialog text through unclamped.
+ cbits/WebView2Shim.c view
@@ -0,0 +1,514 @@+/* jsaddle-webview2: host a jsaddle app in a Microsoft Edge WebView2 control.+ *+ * Plain C against the official WebView2.h (COBJMACROS / C-style COM).  The+ * WebView2Loader.dll is loaded dynamically (LoadLibrary) so nothing from the+ * WebView2 SDK is needed at link time -- only WebView2.h at compile time.+ *+ * Threading: WebView2 is single-threaded (STA).  Everything that touches+ * ICoreWebView2* must run on the thread that created the controller -- the+ * thread that called runJsaddleWebView2 and is pumping the message loop.+ * Calls arriving from other (Haskell) threads are marshalled to it with+ * PostMessage (the payload is a heap-allocated wide string freed by the+ * window proc).+ *+ * The synchronous jsaddle bridge mirrors jsaddle-wkwebview: the page calls+ * window.prompt("JSaddleSync", <Results JSON>); with default script dialogs+ * disabled this raises ScriptDialogOpening on the UI thread while the page's+ * JS is blocked, we call into Haskell (which computes the reply Batch and+ * hands it back via completeSyncWV2 before returning), then put_ResultText ++ * Accept complete the prompt with the Batch JSON.+ */+#define COBJMACROS+#include <windows.h>+#include <objbase.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include "HsFFI.h"+#include "WebView2.h"++#define WM_JSADDLE_EVAL     (WM_APP + 1)+#define WM_JSADDLE_NAV_URL  (WM_APP + 2)+#define WM_JSADDLE_NAV_HTML (WM_APP + 3)++typedef struct JSaddleWV2 {+    HWND hwnd;+    ICoreWebView2Controller *controller;+    ICoreWebView2 *webview;+    HsStablePtr mainCallback;+    HsStablePtr startHandler;+    HsStablePtr resultHandler;+    HsStablePtr syncHandler;+    int handlersSet;+    int started;+    int devTools;+    char *syncResult; /* set by completeSyncWV2 inside jsaddleSyncResult */+} JSaddleWV2;++/* Haskell (foreign export ccall) */+extern void jsaddleStart(HsStablePtr);+extern void jsaddleResult(HsStablePtr, const char *);+extern void jsaddleSyncResult(HsStablePtr, JSaddleWV2 *, const char *);+extern void callWithWebView2(JSaddleWV2 *, HsStablePtr);++/* ---------------------------------------------------------------- utf8 */++static char *utf8FromWide(LPCWSTR w)+{+    if (!w) return NULL;+    int n = WideCharToMultiByte(CP_UTF8, 0, w, -1, NULL, 0, NULL, NULL);+    if (n <= 0) return NULL;+    char *s = (char *)malloc((size_t)n);+    if (s) WideCharToMultiByte(CP_UTF8, 0, w, -1, s, n, NULL, NULL);+    return s;+}++static LPWSTR wideFromUtf8(const char *s)+{+    if (!s) return NULL;+    int n = MultiByteToWideChar(CP_UTF8, 0, s, -1, NULL, 0);+    if (n <= 0) return NULL;+    LPWSTR w = (LPWSTR)malloc((size_t)n * sizeof(WCHAR));+    if (w) MultiByteToWideChar(CP_UTF8, 0, s, -1, w, n);+    return w;+}++/* ------------------------------------------------- generic COM handler+ * Every callback interface WebView2 hands us is IUnknown + one Invoke, so a+ * single struct layout covers them all; only the Invoke slot differs.+ * QueryInterface accepts any IID: WebView2 only ever asks for the interface+ * it was given (or IUnknown), and we have no IID table to compare against+ * without dragging in a MIDL-generated _i.c.+ */+typedef struct Handler {+    const void *lpVtbl;+    volatile LONG rc;+    JSaddleWV2 *app;+} Handler;++static HRESULT STDMETHODCALLTYPE h_QueryInterface(void *self, REFIID riid, void **ppv)+{+    (void)riid;+    if (!ppv) return E_POINTER;+    *ppv = self;+    InterlockedIncrement(&((Handler *)self)->rc);+    return S_OK;+}++static ULONG STDMETHODCALLTYPE h_AddRef(void *self)+{+    return (ULONG)InterlockedIncrement(&((Handler *)self)->rc);+}++static ULONG STDMETHODCALLTYPE h_Release(void *self)+{+    LONG rc = InterlockedDecrement(&((Handler *)self)->rc);+    if (rc == 0) free(self);+    return (ULONG)rc;+}++#define IMPL_UNKNOWN(TYPE) \+    (HRESULT (STDMETHODCALLTYPE *)(TYPE *, REFIID, void **))h_QueryInterface, \+    (ULONG (STDMETHODCALLTYPE *)(TYPE *))h_AddRef, \+    (ULONG (STDMETHODCALLTYPE *)(TYPE *))h_Release++static Handler *newHandler(const void *vtbl, JSaddleWV2 *app)+{+    Handler *h = (Handler *)calloc(1, sizeof *h);+    if (!h) return NULL;+    h->lpVtbl = vtbl;+    h->rc = 1;+    h->app = app;+    return h;+}++/* -------------------------------------------- no-op completed handler+ * Shared by AddScriptToExecuteOnDocumentCreated and ExecuteScript -- both+ * Invoke signatures are (HRESULT, LPCWSTR).+ */+static HRESULT STDMETHODCALLTYPE noop_Invoke(+    ICoreWebView2ExecuteScriptCompletedHandler *self, HRESULT hr, LPCWSTR result)+{+    (void)self; (void)hr; (void)result;+    return S_OK;+}++static const ICoreWebView2ExecuteScriptCompletedHandlerVtbl noopVtbl = {+    IMPL_UNKNOWN(ICoreWebView2ExecuteScriptCompletedHandler),+    noop_Invoke+};++/* --------------------------------------------------- event callbacks */++static HRESULT STDMETHODCALLTYPE navCompleted_Invoke(+    ICoreWebView2NavigationCompletedEventHandler *self,+    ICoreWebView2 *sender, ICoreWebView2NavigationCompletedEventArgs *args)+{+    (void)sender; (void)args;+    JSaddleWV2 *app = ((Handler *)self)->app;+    /* jsaddle state does not survive a reload, so only signal the first+       completed navigation (a second putMVar would block the UI thread). */+    if (app->handlersSet && !app->started) {+        app->started = 1;+        jsaddleStart(app->startHandler);+    }+    return S_OK;+}++static const ICoreWebView2NavigationCompletedEventHandlerVtbl navCompletedVtbl = {+    IMPL_UNKNOWN(ICoreWebView2NavigationCompletedEventHandler),+    navCompleted_Invoke+};++static HRESULT STDMETHODCALLTYPE webMessage_Invoke(+    ICoreWebView2WebMessageReceivedEventHandler *self,+    ICoreWebView2 *sender, ICoreWebView2WebMessageReceivedEventArgs *args)+{+    (void)sender;+    JSaddleWV2 *app = ((Handler *)self)->app;+    LPWSTR msg = NULL;+    if (app->handlersSet+        && SUCCEEDED(ICoreWebView2WebMessageReceivedEventArgs_TryGetWebMessageAsString(args, &msg))+        && msg) {+        char *u = utf8FromWide(msg);+        if (u) {+            jsaddleResult(app->resultHandler, u);+            free(u);+        }+    }+    if (msg) CoTaskMemFree(msg);+    return S_OK;+}++static const ICoreWebView2WebMessageReceivedEventHandlerVtbl webMessageVtbl = {+    IMPL_UNKNOWN(ICoreWebView2WebMessageReceivedEventHandler),+    webMessage_Invoke+};++static HRESULT STDMETHODCALLTYPE scriptDialog_Invoke(+    ICoreWebView2ScriptDialogOpeningEventHandler *self,+    ICoreWebView2 *sender, ICoreWebView2ScriptDialogOpeningEventArgs *args)+{+    (void)sender;+    JSaddleWV2 *app = ((Handler *)self)->app;+    COREWEBVIEW2_SCRIPT_DIALOG_KIND kind;+    if (FAILED(ICoreWebView2ScriptDialogOpeningEventArgs_get_Kind(args, &kind))+        || kind != COREWEBVIEW2_SCRIPT_DIALOG_KIND_PROMPT)+        return S_OK;++    LPWSTR message = NULL;+    ICoreWebView2ScriptDialogOpeningEventArgs_get_Message(args, &message);+    int isSync = message && wcscmp(message, L"JSaddleSync") == 0;+    if (message) CoTaskMemFree(message);+    if (!isSync || !app->handlersSet)+        return S_OK; /* not ours: leave unaccepted, prompt() returns null */++    LPWSTR defText = NULL;+    ICoreWebView2ScriptDialogOpeningEventArgs_get_DefaultText(args, &defText);+    char *u = utf8FromWide(defText);+    if (defText) CoTaskMemFree(defText);+    if (!u) return S_OK;++    free(app->syncResult);+    app->syncResult = NULL;+    /* Synchronous round trip into Haskell: computes the reply Batch and+       stores it via completeSyncWV2 before returning. */+    jsaddleSyncResult(app->syncHandler, app, u);+    free(u);++    if (app->syncResult) {+        LPWSTR w = wideFromUtf8(app->syncResult);+        if (w) {+            ICoreWebView2ScriptDialogOpeningEventArgs_put_ResultText(args, w);+            ICoreWebView2ScriptDialogOpeningEventArgs_Accept(args);+            free(w);+        }+        free(app->syncResult);+        app->syncResult = NULL;+    }+    return S_OK;+}++static const ICoreWebView2ScriptDialogOpeningEventHandlerVtbl scriptDialogVtbl = {+    IMPL_UNKNOWN(ICoreWebView2ScriptDialogOpeningEventHandler),+    scriptDialog_Invoke+};++/* -------------------------------------------- controller / environment */++static HRESULT STDMETHODCALLTYPE controllerCompleted_Invoke(+    ICoreWebView2CreateCoreWebView2ControllerCompletedHandler *self,+    HRESULT hr, ICoreWebView2Controller *controller)+{+    JSaddleWV2 *app = ((Handler *)self)->app;+    if (FAILED(hr) || !controller) {+        fprintf(stderr, "jsaddle-webview2: controller creation failed (0x%08lx)\n",+                (unsigned long)hr);+        PostQuitMessage(1);+        return hr;+    }++    app->controller = controller;+    ICoreWebView2Controller_AddRef(controller);+    ICoreWebView2Controller_get_CoreWebView2(controller, &app->webview);++    ICoreWebView2Settings *settings = NULL;+    ICoreWebView2_get_Settings(app->webview, &settings);+    if (settings) {+        ICoreWebView2Settings_put_IsScriptEnabled(settings, TRUE);+        ICoreWebView2Settings_put_IsWebMessageEnabled(settings, TRUE);+        /* Required for the JSaddleSync prompt() intercept. */+        ICoreWebView2Settings_put_AreDefaultScriptDialogsEnabled(settings, FALSE);+        ICoreWebView2Settings_put_AreDevToolsEnabled(settings, app->devTools ? TRUE : FALSE);+        ICoreWebView2Settings_Release(settings);+    }++    EventRegistrationToken tok;+    Handler *h;++    h = newHandler(&navCompletedVtbl, app);+    ICoreWebView2_add_NavigationCompleted(app->webview,+        (ICoreWebView2NavigationCompletedEventHandler *)h, &tok);+    h_Release(h);++    h = newHandler(&webMessageVtbl, app);+    ICoreWebView2_add_WebMessageReceived(app->webview,+        (ICoreWebView2WebMessageReceivedEventHandler *)h, &tok);+    h_Release(h);++    h = newHandler(&scriptDialogVtbl, app);+    ICoreWebView2_add_ScriptDialogOpening(app->webview,+        (ICoreWebView2ScriptDialogOpeningEventHandler *)h, &tok);+    h_Release(h);++    RECT rc;+    GetClientRect(app->hwnd, &rc);+    ICoreWebView2Controller_put_Bounds(app->controller, rc);+    ICoreWebView2Controller_put_IsVisible(app->controller, TRUE);++    /* Hand control to Haskell: it wires the jsaddle handlers (wv2SetHandlers)+       and starts the initial navigation. */+    callWithWebView2(app, app->mainCallback);+    return S_OK;+}++static const ICoreWebView2CreateCoreWebView2ControllerCompletedHandlerVtbl controllerCompletedVtbl = {+    IMPL_UNKNOWN(ICoreWebView2CreateCoreWebView2ControllerCompletedHandler),+    controllerCompleted_Invoke+};++static HRESULT STDMETHODCALLTYPE envCompleted_Invoke(+    ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler *self,+    HRESULT hr, ICoreWebView2Environment *env)+{+    JSaddleWV2 *app = ((Handler *)self)->app;+    if (FAILED(hr) || !env) {+        fprintf(stderr,+            "jsaddle-webview2: environment creation failed (0x%08lx); is the WebView2 runtime installed?\n",+            (unsigned long)hr);+        PostQuitMessage(1);+        return hr;+    }+    Handler *cc = newHandler(&controllerCompletedVtbl, app);+    HRESULT r = ICoreWebView2Environment_CreateCoreWebView2Controller(env, app->hwnd,+        (ICoreWebView2CreateCoreWebView2ControllerCompletedHandler *)cc);+    h_Release(cc);+    if (FAILED(r)) {+        fprintf(stderr, "jsaddle-webview2: CreateCoreWebView2Controller failed (0x%08lx)\n",+                (unsigned long)r);+        PostQuitMessage(1);+    }+    return r;+}++static const ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandlerVtbl envCompletedVtbl = {+    IMPL_UNKNOWN(ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler),+    envCompleted_Invoke+};++/* ------------------------------------------------------- window proc */++static LRESULT CALLBACK wndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp)+{+    JSaddleWV2 *app = (JSaddleWV2 *)GetWindowLongPtrW(hwnd, GWLP_USERDATA);+    switch (msg) {+    case WM_SIZE:+        if (app && app->controller) {+            RECT rc;+            GetClientRect(hwnd, &rc);+            ICoreWebView2Controller_put_Bounds(app->controller, rc);+        }+        return 0;+    case WM_MOVE:+        if (app && app->controller)+            ICoreWebView2Controller_NotifyParentWindowPositionChanged(app->controller);+        return 0;+    case WM_JSADDLE_EVAL:+        if (app && app->webview) {+            Handler *h = newHandler(&noopVtbl, app);+            ICoreWebView2_ExecuteScript(app->webview, (LPCWSTR)lp,+                (ICoreWebView2ExecuteScriptCompletedHandler *)h);+            h_Release(h);+        }+        free((void *)lp);+        return 0;+    case WM_JSADDLE_NAV_URL:+        if (app && app->webview)+            ICoreWebView2_Navigate(app->webview, (LPCWSTR)lp);+        free((void *)lp);+        return 0;+    case WM_JSADDLE_NAV_HTML:+        if (app && app->webview)+            ICoreWebView2_NavigateToString(app->webview, (LPCWSTR)lp);+        free((void *)lp);+        return 0;+    case WM_DESTROY:+        PostQuitMessage(0);+        return 0;+    }+    return DefWindowProcW(hwnd, msg, wp, lp);+}++/* ------------------------------------------- API called from Haskell */++/* The Win32 HWND of the window hosting the WebView2, so the embedding+   application can do native window integration (menu bar, dialogs). */+void *wv2GetHwnd(JSaddleWV2 *app)+{+    return (void *)app->hwnd;+}++void wv2SetHandlers(JSaddleWV2 *app, HsStablePtr start, HsStablePtr result, HsStablePtr sync)+{+    app->startHandler = start;+    app->resultHandler = result;+    app->syncHandler = sync;+    app->handlersSet = 1;+}++/* Thread-safe: marshalled to the UI thread via PostMessage. */+void wv2Eval(JSaddleWV2 *app, const char *js)+{+    LPWSTR w = wideFromUtf8(js);+    if (w && !PostMessageW(app->hwnd, WM_JSADDLE_EVAL, 0, (LPARAM)w))+        free(w);+}++void wv2Navigate(JSaddleWV2 *app, const char *url)+{+    LPWSTR w = wideFromUtf8(url);+    if (w && !PostMessageW(app->hwnd, WM_JSADDLE_NAV_URL, 0, (LPARAM)w))+        free(w);+}++void wv2NavigateToString(JSaddleWV2 *app, const char *html)+{+    LPWSTR w = wideFromUtf8(html);+    if (w && !PostMessageW(app->hwnd, WM_JSADDLE_NAV_HTML, 0, (LPARAM)w))+        free(w);+}++/* Called by Haskell inside jsaddleSyncResult (same thread, same dynamic+   extent) with the reply Batch JSON for the pending JSaddleSync prompt. */+void completeSyncWV2(JSaddleWV2 *app, const char *s)+{+    free(app->syncResult);+    app->syncResult = s ? strdup(s) : NULL;+}++typedef HRESULT (STDMETHODCALLTYPE *CreateEnvFn)(+    PCWSTR, PCWSTR, ICoreWebView2EnvironmentOptions *,+    ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler *);++int runJsaddleWebView2(HsStablePtr mainCallback, const char *title,+                       int width, int height, int devTools)+{+    /* Per-monitor v2 DPI awareness, where available (Win10 1703+). */+    HMODULE user32 = GetModuleHandleW(L"user32.dll");+    if (user32) {+        typedef BOOL (WINAPI *SetDpiCtxFn)(HANDLE);+        SetDpiCtxFn setCtx = (SetDpiCtxFn)(void *)GetProcAddress(user32, "SetProcessDpiAwarenessContext");+        if (setCtx) setCtx((HANDLE)-4 /* DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 */);+    }++    HMODULE loader = LoadLibraryW(L"WebView2Loader.dll");+    if (!loader) {+        fprintf(stderr, "jsaddle-webview2: WebView2Loader.dll not found; place it next to the executable\n");+        return 1;+    }+    CreateEnvFn createEnv = (CreateEnvFn)(void *)GetProcAddress(loader, "CreateCoreWebView2EnvironmentWithOptions");+    if (!createEnv) {+        fprintf(stderr, "jsaddle-webview2: CreateCoreWebView2EnvironmentWithOptions not found in WebView2Loader.dll\n");+        return 1;+    }++    HRESULT hr = CoInitializeEx(NULL, COINIT_APARTMENTTHREADED);+    if (FAILED(hr)) {+        fprintf(stderr, "jsaddle-webview2: CoInitializeEx failed (0x%08lx)\n", (unsigned long)hr);+        return 1;+    }++    JSaddleWV2 *app = (JSaddleWV2 *)calloc(1, sizeof *app);+    app->mainCallback = mainCallback;+    app->devTools = devTools;++    WNDCLASSW wc;+    memset(&wc, 0, sizeof wc);+    wc.lpfnWndProc = wndProc;+    wc.hInstance = GetModuleHandleW(NULL);+    wc.lpszClassName = L"JSaddleWebView2";+    wc.hCursor = LoadCursorW(NULL, MAKEINTRESOURCEW(32512) /* IDC_ARROW */);+    wc.hbrBackground = (HBRUSH)(COLOR_WINDOW + 1);+    RegisterClassW(&wc);++    LPWSTR wtitle = wideFromUtf8(title);+    app->hwnd = CreateWindowExW(0, wc.lpszClassName, wtitle ? wtitle : L"JSaddle",+        WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT,+        width > 0 ? width : CW_USEDEFAULT, height > 0 ? height : CW_USEDEFAULT,+        NULL, NULL, wc.hInstance, NULL);+    free(wtitle);+    if (!app->hwnd) {+        fprintf(stderr, "jsaddle-webview2: CreateWindow failed\n");+        return 1;+    }+    SetWindowLongPtrW(app->hwnd, GWLP_USERDATA, (LONG_PTR)app);+    ShowWindow(app->hwnd, SW_SHOWDEFAULT);+    UpdateWindow(app->hwnd);++    /* Default user-data folder is next to the exe, which fails under+       Program Files; use %LOCALAPPDATA%\jsaddle-webview2 instead. */+    WCHAR udf[MAX_PATH];+    PCWSTR udfArg = NULL;+    DWORD n = GetEnvironmentVariableW(L"LOCALAPPDATA", udf, MAX_PATH);+    if (n > 0 && n + 20 < MAX_PATH) {+        wcscat(udf, L"\\jsaddle-webview2");+        CreateDirectoryW(udf, NULL);+        udfArg = udf;+    }++    Handler *envH = newHandler(&envCompletedVtbl, app);+    hr = createEnv(NULL, udfArg, NULL,+        (ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler *)envH);+    h_Release(envH);+    if (FAILED(hr)) {+        fprintf(stderr,+            "jsaddle-webview2: CreateCoreWebView2EnvironmentWithOptions failed (0x%08lx); is the WebView2 runtime installed?\n",+            (unsigned long)hr);+        return 1;+    }++    MSG msg;+    while (GetMessageW(&msg, NULL, 0, 0) > 0) {+        TranslateMessage(&msg);+        DispatchMessageW(&msg);+    }++    if (app->webview) ICoreWebView2_Release(app->webview);+    if (app->controller) ICoreWebView2Controller_Release(app->controller);+    free(app->syncResult);+    free(app);+    CoUninitialize();+    FreeLibrary(loader);++    return (int)msg.wParam;+}
+ demo/Main.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+-- | Minimal jsaddle-webview2 demo: a click counter (exercises the+--   synchronous prompt bridge via the callback) and an uptime ticker+--   (exercises async batches from a background Haskell thread).+module Main (main) where++import Control.Concurrent (forkIO, threadDelay)+import Control.Monad (forever, void)+import Control.Monad.IO.Class (liftIO)+import Data.IORef (atomicModifyIORef', newIORef)+import qualified Data.Text as T+import Language.Javascript.JSaddle+import qualified Language.Javascript.JSaddle.WebView2 as WV2++main :: IO ()+main = WV2.run $ do+    doc <- jsg "document"+    body <- doc ! "body"+    void $ body # "insertAdjacentHTML" $+        ( "beforeend"+        , "<h1>jsaddle-webview2 demo</h1>\+          \<p>Uptime: <span id=\"uptime\">0</span>s</p>\+          \<p><button id=\"btn\">Clicked <span id=\"count\">0</span> times</button></p>"+        )++    clicks <- liftIO $ newIORef (0 :: Int)+    btn <- doc # "getElementById" $ ["btn"]+    void $ btn # "addEventListener" $+        ( "click"+        , fun $ \_ _ _ -> do+            n <- liftIO $ atomicModifyIORef' clicks $ \c -> (c + 1, c + 1)+            el <- doc # "getElementById" $ ["count"]+            el <# "textContent" $ T.pack (show n)+        )++    seconds <- liftIO $ newIORef (0 :: Int)+    ctx <- askJSM+    void . liftIO . forkIO . forever $ do+        threadDelay 1000000+        s <- atomicModifyIORef' seconds $ \c -> (c + 1, c + 1)+        runJSaddle ctx $ do+            el <- jsg "document" # "getElementById" $ ["uptime"]+            el <# "textContent" $ T.pack (show s)
+ jsaddle-webview2.cabal view
@@ -0,0 +1,57 @@+cabal-version: 3.0+name: jsaddle-webview2+version: 0.1.0.0+build-type: Simple+license: MIT+license-file: LICENSE+extra-doc-files: ChangeLog.md README.md+maintainer: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>+synopsis: Interface for JavaScript that works with GHCJS and GHC+description:+    jsaddle backend for Windows: hosts the app in a native Win32 window+    containing a Microsoft Edge WebView2 control.  The Windows sibling of+    jsaddle-wkwebview (macOS/iOS) and jsaddle-webkitgtk (Linux).++    Building needs WebView2.h from the Microsoft.Web.WebView2 NuGet package+    on the include path (see the README); nothing from the SDK is needed at+    link time.  Running needs the WebView2 runtime (preinstalled on Windows+    11) and WebView2Loader.dll next to the executable.+category: Web, Javascript+author: Hamish Mackenzie++source-repository head+    type: git+    location: https://github.com/ghcjs/jsaddle+    subdir: jsaddle-webview2++library+    exposed-modules:+        Language.Javascript.JSaddle.WebView2+        Language.Javascript.JSaddle.WebView2.Internal+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -ferror-spans -Wall+    build-depends:+        base <5,+        aeson >=0.8.0.2 && <2.4,+        bytestring >=0.10.6.0 && <0.13,+        data-default >=0.7 && <0.9,+        jsaddle >=0.9.9.0 && <0.10,+        text >=1.2.1.3 && <1.3 || >=2.0 && <2.2+    c-sources: cbits/WebView2Shim.c+    extra-libraries: ole32, user32+    if !os(windows)+        buildable: False++executable jsaddle-webview2-demo+    main-is: Main.hs+    hs-source-dirs: demo+    default-language: Haskell2010+    ghc-options: -threaded -Wall+    build-depends:+        base,+        jsaddle,+        jsaddle-webview2,+        text+    if !os(windows)+        buildable: False
+ src/Language/Javascript/JSaddle/WebView2.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}+-- | Run jsaddle apps in a native Windows window hosting a Microsoft Edge+--   WebView2 control.  The Windows sibling of+--   "Language.Javascript.JSaddle.WKWebView" (macOS\/iOS) and+--   "Language.Javascript.JSaddle.WebKitGTK" (Linux).+--+--   Requirements on the target machine:+--+--   * the WebView2 runtime (preinstalled on Windows 11; Evergreen-installed+--     on most Windows 10 machines, or bundle the installer), and+--+--   * @WebView2Loader.dll@ from the WebView2 SDK NuGet package+--     (@Microsoft.Web.WebView2@, @runtimes\/win-x64\/native@) next to the+--     executable.  It is loaded dynamically, so nothing from the SDK is+--     needed at link time.+module Language.Javascript.JSaddle.WebView2+    ( run+    , runHTML+    , runURL+    , run'+    , WebView2Config(..)+    , WebView2(..)+    , webView2Hwnd+    ) where++import Control.Monad (unless)+import Data.ByteString (ByteString, useAsCString)+import Data.Default (Default(..))+import Data.Text (Text)+import qualified Data.Text as T (pack)+import Data.Text.Encoding (encodeUtf8)++import Foreign.C.String (CString)+import Foreign.C.Types (CInt(..))+import Foreign.Ptr (Ptr)+import Foreign.StablePtr (StablePtr, newStablePtr)++import Language.Javascript.JSaddle (JSM)+import Language.Javascript.JSaddle.WebView2.Internal+       (jsaddleMain, jsaddleMainHTML, jsaddleMainURL, WebView2(..))+import System.Environment (getProgName)++foreign import ccall wv2GetHwnd :: WebView2 -> IO (Ptr ())++-- | The Win32 @HWND@ of the window hosting the WebView2, for native window+--   integration (menu bar, dialogs) by the embedding application.  Only+--   meaningful once the 'run'' callback has been entered.+webView2Hwnd :: WebView2 -> IO (Ptr ())+webView2Hwnd = wv2GetHwnd++foreign import ccall runJsaddleWebView2+    :: StablePtr (WebView2 -> IO ())+    -> CString -- ^ window title (utf8)+    -> CInt    -- ^ initial width  (<=0 for default)+    -> CInt    -- ^ initial height (<=0 for default)+    -> CInt    -- ^ enable dev tools+    -> IO CInt++data WebView2Config = WebView2Config+    { _webView2Config_title :: Maybe Text+    -- ^ Window title; 'Nothing' uses the program name.+    , _webView2Config_width :: Int+    -- ^ Initial window width; @<= 0@ for the system default.+    , _webView2Config_height :: Int+    -- ^ Initial window height; @<= 0@ for the system default.+    , _webView2Config_devTools :: Bool+    -- ^ Allow opening the Edge dev tools (F12).  Defaults to 'True'.+    }++instance Default WebView2Config where+    def = WebView2Config+        { _webView2Config_title = Nothing+        , _webView2Config_width = 0+        , _webView2Config_height = 0+        , _webView2Config_devTools = True+        }++-- | Run a jsaddle app in a WebView2 window (blank initial page).+run :: JSM () -> IO ()+run f = run' def (jsaddleMain f)++-- | Run a jsaddle app in a WebView2 window, starting from the given HTML+--   (loaded with @NavigateToString@: origin @about:blank@, 2MB limit).+runHTML :: ByteString -> WebView2Config -> JSM () -> IO ()+runHTML html cfg = run' cfg . jsaddleMainHTML html++-- | Run a jsaddle app in a WebView2 window, first navigating to the given+--   URL (@file:\/\/@, @https:\/\/@, ...).+runURL :: ByteString -> WebView2Config -> JSM () -> IO ()+runURL url cfg = run' cfg . jsaddleMainURL url++-- | Run an action with the WebView2 once its controller is ready.  This is+--   the escape hatch mirroring 'Language.Javascript.JSaddle.WKWebView.run'':+--   the callback runs on the UI thread before any navigation has started.+run' :: WebView2Config -> (WebView2 -> IO ()) -> IO ()+run' cfg main = do+    title <- maybe (T.pack <$> getProgName) pure (_webView2Config_title cfg)+    mainPtr <- newStablePtr main+    r <- useAsCString (encodeUtf8 title) $ \t ->+        runJsaddleWebView2 mainPtr t+            (fromIntegral $ _webView2Config_width cfg)+            (fromIntegral $ _webView2Config_height cfg)+            (if _webView2Config_devTools cfg then 1 else 0)+    unless (r == 0) . ioError . userError $+        "jsaddle-webview2 failed to start (is the WebView2 runtime installed and WebView2Loader.dll next to the executable?)"
+ src/Language/Javascript/JSaddle/WebView2/Internal.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}+-- | Wiring between jsaddle's 'runJavaScript' transport and the WebView2+--   C shim (@cbits/WebView2Shim.c@).  Mirrors+--   "Language.Javascript.JSaddle.WKWebView.Internal".+module Language.Javascript.JSaddle.WebView2.Internal+    ( jsaddleMain+    , jsaddleMainHTML+    , jsaddleMainURL+    , WebView2(..)+    ) where++import Control.Monad (void, join)+import Control.Concurrent (forkIO, forkOS)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)++import Data.ByteString (useAsCString)+import qualified Data.ByteString as BS (ByteString, packCString)+import Data.ByteString.Lazy (ByteString, toStrict, fromStrict)+import Data.Aeson (encode, decode)++import Foreign.C.String (CString)+import Foreign.Ptr (Ptr)+import Foreign.StablePtr (StablePtr, newStablePtr, deRefStablePtr)++import Language.Javascript.JSaddle (Results, Batch, JSM)+import Language.Javascript.JSaddle.Run (runJavaScript)+import Language.Javascript.JSaddle.Run.Files (initState, runBatch, ghcjsHelpers)++newtype WebView2 = WebView2 (Ptr WebView2)++foreign export ccall jsaddleStart :: StablePtr (IO ()) -> IO ()+foreign export ccall jsaddleResult :: StablePtr (Results -> IO ()) -> CString -> IO ()+foreign export ccall jsaddleSyncResult :: StablePtr (Results -> IO Batch) -> WebView2 -> CString -> IO ()+foreign export ccall callWithWebView2 :: WebView2 -> StablePtr (WebView2 -> IO ()) -> IO ()++foreign import ccall wv2SetHandlers+    :: WebView2 -> StablePtr (IO ()) -> StablePtr (Results -> IO ()) -> StablePtr (Results -> IO Batch) -> IO ()+foreign import ccall wv2Eval :: WebView2 -> CString -> IO ()+foreign import ccall wv2Navigate :: WebView2 -> CString -> IO ()+foreign import ccall wv2NavigateToString :: WebView2 -> CString -> IO ()+foreign import ccall completeSyncWV2 :: WebView2 -> CString -> IO ()++-- | Run a jsaddle app in the WebView2, starting from a minimal blank page.+jsaddleMain :: JSM () -> WebView2 -> IO ()+jsaddleMain = jsaddleMainHTML (toStrict indexHtml)++-- | Run a jsaddle app in the WebView2, starting from the given HTML+--   (loaded with @NavigateToString@, so the page origin is @about:blank@+--   and the content is limited to 2MB).+jsaddleMainHTML :: BS.ByteString -> JSM () -> WebView2 -> IO ()+jsaddleMainHTML html f webView =+    jsaddleMain' f webView $+        useAsCString html $ wv2NavigateToString webView++-- | Run a jsaddle app in the WebView2, first navigating to the given URL+--   (@file://@, @https://@, ...).+jsaddleMainURL :: BS.ByteString -> JSM () -> WebView2 -> IO ()+jsaddleMainURL url f webView =+    jsaddleMain' f webView $+        useAsCString url $ wv2Navigate webView++jsaddleMain' :: JSM () -> WebView2 -> IO () -> IO ()+jsaddleMain' f webView navigate = do+    ready <- newEmptyMVar++    (processResult, syncResult, start) <- runJavaScript (\batch ->+        useAsCString (toStrict $ "runJSaddleBatch(" <> encode batch <> ");") $+            wv2Eval webView)+        f++    startHandler <- newStablePtr (putMVar ready ())+    resultHandler <- newStablePtr processResult+    syncResultHandler <- newStablePtr syncResult+    wv2SetHandlers webView startHandler resultHandler syncResultHandler+    navigate+    void . forkOS $ do+        takeMVar ready+        useAsCString (toStrict jsaddleJs) (wv2Eval webView) >> void (forkIO start)++jsaddleStart :: StablePtr (IO ()) -> IO ()+jsaddleStart ptrHandler = join (deRefStablePtr ptrHandler)++jsaddleResult :: StablePtr (Results -> IO ()) -> CString -> IO ()+jsaddleResult ptrHandler s = do+    processResult <- deRefStablePtr ptrHandler+    result <- BS.packCString s+    case decode (fromStrict result) of+        Nothing -> error $ "jsaddle Results decode failed : " <> show result+        Just r  -> processResult r++-- | Called from the ScriptDialogOpening handler while the page's JS is+--   blocked in @window.prompt("JSaddleSync", ...)@.  The reply Batch must be+--   handed back with 'completeSyncWV2' before this returns (the C side reads+--   it right after).+jsaddleSyncResult :: StablePtr (Results -> IO Batch) -> WebView2 -> CString -> IO ()+jsaddleSyncResult ptrHandler webView s = do+    syncProcessResult <- deRefStablePtr ptrHandler+    result <- BS.packCString s+    case decode (fromStrict result) of+        Nothing -> error $ "jsaddle Results decode failed : " <> show result+        Just r  -> do+            batch <- syncProcessResult r+            useAsCString (toStrict $ encode batch) $+                completeSyncWV2 webView++callWithWebView2 :: WebView2 -> StablePtr (WebView2 -> IO ()) -> IO ()+callWithWebView2 webView ptrF = do+    f <- deRefStablePtr ptrF+    f webView++jsaddleJs :: ByteString+jsaddleJs = ghcjsHelpers <> "\+    \runJSaddleBatch = (function() {\n\+    \ " <> initState <> "\n\+    \ return function(batch) {\n\+    \ " <> runBatch (\a -> "window.chrome.webview.postMessage(JSON.stringify(" <> a <> "));\n")+                    (Just (\a -> "JSON.parse(window.prompt(\"JSaddleSync\", JSON.stringify(" <> a <> ")))")) <> "\+    \ };\n\+    \})();\n\+    \"++indexHtml :: ByteString+indexHtml =+    "<!DOCTYPE html>\n\+    \<html>\n\+    \<head>\n\+    \<meta charset=\"utf-8\">\n\+    \<title>JSaddle</title>\n\+    \</head>\n\+    \<body>\n\+    \</body>\n\+    \</html>"