Native macOS GUI Applications with WebKit and Haskell FFI

Building graphical user interfaces (GUIs) in Haskell has historically been a challenging endeavor. While toolkits like GTK (via gi-gtk) or wxHaskell exist, they often require heavy dependencies, complex installations, and extensive boilerplate code. Another popular modern alternative is Electron, but it packages a complete Chromium browser, resulting in massive binary sizes and heavy memory footprints.

In this chapter, we explore a lightweight alternative: webkit-haskell (ported from Common Lisp’s webkit-cl and Rust’s webkit-rust). This framework allows you to build native macOS desktop applications using the operating system’s built-in WebKit engine (WKWebView).

By embedding WebKit, we can design beautiful, modern, responsive user interfaces using standard web technologies (HTML, CSS, and JavaScript) while keeping the application backend logic entirely in Haskell. Communication between the JavaScript front-end and the Haskell back-end is performed bidirectionally through a fast, JSON-based message-passing bridge.

The code for this project is located in the directory haskell_book/source-code/webkit-haskell.


The FFI Architecture

Haskell’s Foreign Function Interface (FFI) is natively designed to interoperate with C. Interfacing directly with Objective-C classes and methods (such as Cocoa’s NSWindow or WebKit’s WKWebView) is difficult because Objective-C is a dynamic language that relies on message passing via objc_msgSend.

To bridge this gap, we implement a thin C wrapper in Objective-C. This wrapper exposes a flat C API that Haskell’s foreign import ccall can easily invoke.

 1 +-------------------------------------------------------+
 2 |                 JavaScript Web UI                     |
 3 |        (window.webkit_haskell.invoke(cmd, arg))       |
 4 +---------------------------+---------------------------+
 5                             |
 6                             v (WKScriptMessageHandler)
 7 +-------------------------------------------------------+
 8 |              Objective-C Wrapper (C API)              |
 9 |        - Creates NSWindow & WKWebView                 |
10 |        - Implements Flat C function pointers          |
11 +---------------------------+---------------------------+
12                             |
13                             v (Haskell FunPtr Callback)
14 +-------------------------------------------------------+
15 |                  Haskell FFI Module                   |
16 |        - Decodes/encodes payloads using Aeson         |
17 |        - Looks up command handers in IORef map        |
18 +-------------------------------------------------------+

Key FFI Concepts

  1. Stable Pointers (StablePtr): GHC manages Haskell objects in a garbage-collected heap and may move them during GC cycles. A StablePtr is a stable reference to a Haskell value that GHC guarantees will not move, allowing us to safely pass it to the C/Objective-C side as userdata.
  2. FunPtr Wrappers: To allow the C side to call a Haskell function, GHC provides a wrapper generator that marshals a Haskell function into a C-compatible function pointer (FunPtr).
  3. Memory Handoff (Malloc/Free): Strings returned by Haskell callbacks to C are allocated on the standard C heap via GHC’s FFI newCString (which calls standard malloc). The Objective-C code takes ownership of the string and calls C’s free() after converting it to an Objective-C NSString.
  4. Exception Shielding: Exceptions in Haskell callbacks are caught using Control.Exception.catch and returned as a JSON error object, preventing Haskell panics from crashing the macOS GUI thread.

The C Interface: webkit_haskell.h

The header file defines the flat C interface exported by the Objective-C wrapper.

 1 /* webkit_haskell.h — C API for webkit-haskell */
 2 
 3 #ifndef WEBKIT_HASKELL_H
 4 #define WEBKIT_HASKELL_H
 5 
 6 #ifdef __cplusplus
 7 extern "C" {
 8 #endif
 9 
10 typedef void* wkhsk_app_t;
11 
12 /* Callback type for bridge invocations from JavaScript */
13 typedef const char* (*wkhsk_bridge_callback_t)(const char* command,
14                                                const char* payload,
15                                                void* userdata);
16 
17 /* Lifecycle */
18 wkhsk_app_t wkhsk_create(const char* title, int width, int height);
19 void wkhsk_run(wkhsk_app_t app);
20 void wkhsk_quit(wkhsk_app_t app);
21 void wkhsk_destroy(wkhsk_app_t app);
22 
23 /* Content Loading */
24 void wkhsk_load_html(wkhsk_app_t app, const char* html);
25 void wkhsk_load_url(wkhsk_app_t app, const char* url);
26 void wkhsk_load_file(wkhsk_app_t app, const char* path);
27 
28 /* JavaScript */
29 void wkhsk_eval_js(wkhsk_app_t app, const char* js);
30 
31 /* Bridge */
32 void wkhsk_set_bridge_callback(wkhsk_app_t app,
33                                wkhsk_bridge_callback_t callback,
34                                void* userdata);
35 
36 /* Window Management */
37 void wkhsk_set_title(wkhsk_app_t app, const char* title);
38 void wkhsk_set_size(wkhsk_app_t app, int width, int height);
39 void wkhsk_set_resizable(wkhsk_app_t app, int resizable);
40 
41 #ifdef __cplusplus
42 }
43 #endif
44 
45 #endif /* WEBKIT_HASKELL_H */

On the implementation side in webkit_haskell.m, Cocoa initializes a standard macOS application runloop ([nsApp run]), creates an NSWindow and a WKWebView, and injects a script into the browser context to establish window.webkit_haskell.invoke. When JavaScript calls this method, the message is serialized to JSON and passed to the registered Haskell callback.


The Haskell FFI Wrapper: WebKitHaskell.hs

The Haskell wrapper handles the raw foreign function imports, manages the callback lifecycle, and handles the marshalling of JSON strings using Data.Aeson.

  1 {-# LANGUAGE ForeignFunctionInterface #-}
  2 {-# LANGUAGE OverloadedStrings #-}
  3 {-# LANGUAGE ScopedTypeVariables #-}
  4 
  5 module WebKitHaskell
  6   ( WebKitApp
  7   , newWebKitApp
  8   , runWebKitApp
  9   , quitWebKitApp
 10   , destroyWebKitApp
 11   , loadHTML
 12   , loadURL
 13   , loadFile
 14   , evalJS
 15   , setTitle
 16   , setSize
 17   , setResizable
 18   , registerHandler
 19   ) where
 20 
 21 import Foreign
 22 import Foreign.C.String
 23 import Foreign.C.Types
 24 import Foreign.StablePtr
 25 import Data.IORef
 26 import qualified Data.Map.Strict as Map
 27 import qualified Data.Aeson as Aeson
 28 import qualified Data.ByteString.Lazy.Char8 as LBS
 29 import Control.Exception (catch, SomeException)
 30 
 31 -- ---------------------------------------------------------------------------
 32 -- Native FFI Declarations
 33 -- ---------------------------------------------------------------------------
 34 
 35 foreign import ccall unsafe "wkhsk_create"
 36   c_wkhsk_create :: CString -> CInt -> CInt -> IO (Ptr ())
 37 
 38 foreign import ccall safe "wkhsk_run"
 39   c_wkhsk_run :: Ptr () -> IO ()
 40 
 41 foreign import ccall unsafe "wkhsk_quit"
 42   c_wkhsk_quit :: Ptr () -> IO ()
 43 
 44 foreign import ccall unsafe "wkhsk_destroy"
 45   c_wkhsk_destroy :: Ptr () -> IO ()
 46 
 47 foreign import ccall unsafe "wkhsk_load_html"
 48   c_wkhsk_load_html :: Ptr () -> CString -> IO ()
 49 
 50 foreign import ccall unsafe "wkhsk_load_url"
 51   c_wkhsk_load_url :: Ptr () -> CString -> IO ()
 52 
 53 foreign import ccall unsafe "wkhsk_load_file"
 54   c_wkhsk_load_file :: Ptr () -> CString -> IO ()
 55 
 56 foreign import ccall unsafe "wkhsk_eval_js"
 57   c_wkhsk_eval_js :: Ptr () -> CString -> IO ()
 58 
 59 foreign import ccall unsafe "wkhsk_set_bridge_callback"
 60   c_wkhsk_set_bridge_callback :: Ptr () -> FunPtr BridgeCallback -> Ptr () -> IO ()
 61 
 62 foreign import ccall unsafe "wkhsk_set_title"
 63   c_wkhsk_set_title :: Ptr () -> CString -> IO ()
 64 
 65 foreign import ccall unsafe "wkhsk_set_size"
 66   c_wkhsk_set_size :: Ptr () -> CInt -> CInt -> IO ()
 67 
 68 foreign import ccall unsafe "wkhsk_set_resizable"
 69   c_wkhsk_set_resizable :: Ptr () -> CInt -> IO ()
 70 
 71 -- ---------------------------------------------------------------------------
 72 -- Dynamic Callback Marshaller
 73 -- ---------------------------------------------------------------------------
 74 
 75 type BridgeCallback = CString -> CString -> Ptr () -> IO CString
 76 
 77 foreign import ccall "wrapper"
 78   makeBridgeCallback :: BridgeCallback -> IO (FunPtr BridgeCallback)
 79 
 80 -- ---------------------------------------------------------------------------
 81 -- Haskell WebKitApp Type
 82 -- ---------------------------------------------------------------------------
 83 
 84 type Handlers = Map.Map String (Aeson.Value -> IO Aeson.Value)
 85 
 86 data WebKitApp = WebKitApp
 87   { appHandle          :: Ptr ()
 88   , appHandlers        :: IORef Handlers
 89   , appStablePtr       :: StablePtr (IORef Handlers)
 90   , appCallbackFunPtr  :: FunPtr BridgeCallback
 91   }
 92 
 93 -- ---------------------------------------------------------------------------
 94 -- Public API
 95 -- ---------------------------------------------------------------------------
 96 
 97 newWebKitApp :: String -> Int -> Int -> IO WebKitApp
 98 newWebKitApp title width height = do
 99   cTitle <- newCString title
100   handle <- c_wkhsk_create cTitle (fromIntegral width) (fromIntegral height)
101   free cTitle
102   if handle == nullPtr
103     then error "Failed to create native Cocoa/WebKit window"
104     else do
105       handlersRef <- newIORef Map.empty
106       stablePtr <- newStablePtr handlersRef
107       
108       -- Create the dynamic callback function pointer referencing bridgeDispatch
109       callbackFunPtr <- makeBridgeCallback (bridgeDispatch stablePtr)
110       
111       -- Connect the callback on the C side, passing stablePtr as userdata
112       c_wkhsk_set_bridge_callback handle callbackFunPtr (castStablePtrToPtr stablePtr)
113       
114       return $ WebKitApp handle handlersRef stablePtr callbackFunPtr
115 
116 runWebKitApp :: WebKitApp -> IO ()
117 runWebKitApp app = c_wkhsk_run (appHandle app)
118 
119 quitWebKitApp :: WebKitApp -> IO ()
120 quitWebKitApp app = c_wkhsk_quit (appHandle app)
121 
122 destroyWebKitApp :: WebKitApp -> IO ()
123 destroyWebKitApp app = do
124   c_wkhsk_destroy (appHandle app)
125   freeHaskellFunPtr (appCallbackFunPtr app)
126   freeStablePtr (appStablePtr app)
127 
128 loadHTML :: WebKitApp -> String -> IO ()
129 loadHTML app html = do
130   cHtml <- newCString html
131   c_wkhsk_load_html (appHandle app) cHtml
132   free cHtml
133 
134 loadURL :: WebKitApp -> String -> IO ()
135 loadURL app url = do
136   cUrl <- newCString url
137   c_wkhsk_load_url (appHandle app) cUrl
138   free cUrl
139 
140 loadFile :: WebKitApp -> String -> IO ()
141 loadFile app path = do
142   cPath <- newCString path
143   c_wkhsk_load_file (appHandle app) cPath
144   free cPath
145 
146 evalJS :: WebKitApp -> String -> IO ()
147 evalJS app js = do
148   cJs <- newCString js
149   c_wkhsk_eval_js (appHandle app) cJs
150   free cJs
151 
152 setTitle :: WebKitApp -> String -> IO ()
153 setTitle app title = do
154   cTitle <- newCString title
155   c_wkhsk_set_title (appHandle app) cTitle
156   free cTitle
157 
158 setSize :: WebKitApp -> Int -> Int -> IO ()
159 setSize app width height =
160   c_wkhsk_set_size (appHandle app) (fromIntegral width) (fromIntegral height)
161 
162 setResizable :: WebKitApp -> Bool -> IO ()
163 setResizable app resizable =
164   c_wkhsk_set_resizable (appHandle app) (if resizable then 1 else 0)
165 
166 registerHandler :: WebKitApp -> String -> (Aeson.Value -> IO Aeson.Value) -> IO ()
167 registerHandler app command handler =
168   modifyIORef' (appHandlers app) (Map.insert command handler)
169 
170 -- ---------------------------------------------------------------------------
171 -- Private Dispatcher
172 -- ---------------------------------------------------------------------------
173 
174 bridgeDispatch :: StablePtr (IORef Handlers) -> CString -> CString -> Ptr () -> IO CString
175 bridgeDispatch stablePtr cmdPtr payloadPtr _ = do
176   handlersRef <- deRefStablePtr stablePtr
177   cmd <- peekCString cmdPtr
178   payloadStr <- peekCString payloadPtr
179   
180   -- Decode payload as JSON
181   let payloadJson = case Aeson.decode (LBS.pack payloadStr) of
182                       Just val -> val
183                       Nothing  -> Aeson.Null
184   
185   handlers <- readIORef handlersRef
186   resultJson <- case Map.lookup cmd handlers of
187     Just handler ->
188       catch (handler payloadJson)
189             (\(e :: SomeException) -> return $ Aeson.object ["error" Aeson..= show e])
190     Nothing ->
191       return $ Aeson.object ["error" Aeson..= ("Unknown command: " ++ cmd)]
192       
193   -- Encode response to JSON and allocate a standard C string to pass to C side
194   let resultBytes = LBS.unpack (Aeson.encode resultJson)
195   newCString resultBytes

Explaining bridgeDispatch

  • deRefStablePtr converts the pointer passed from Objective-C (userdata) back into a usable Haskell reference to our IORef Handlers map.
  • peekCString reads the raw FFI C-string pointers (cmdPtr, payloadPtr) into standard Haskell String values.
  • We lookup the command in the handlers map. If it exists, we run it and catch exceptions using catch to prevent any backend failure from terminating the native macOS loop.
  • We encode the resulting Aeson.Value back into a JSON string and use newCString to allocate it as a raw C string. Because the Objective-C code calls free() on this pointer once it converts it to an NSString, this handoff avoids memory leaks.

Cabal Build System Configuration

To compile Objective-C sources and correctly link macOS system frameworks, we write a simple Cabal description. The relevant portion of webkit-haskell.cabal looks like this:

 1 library
 2   exposed-modules:     WebKitHaskell
 3   build-depends:       base >= 4.7 && < 5
 4                      , aeson >= 1.0
 5                      , bytestring >= 0.10
 6                      , containers >= 0.6
 7                      , directory >= 1.3
 8                      , filepath >= 1.4
 9   hs-source-dirs:      src
10   default-language:    Haskell2010
11   ghc-options:         -Wall
12   
13   if os(darwin)
14     c-sources:         cbits/webkit_haskell.m
15     include-dirs:      cbits
16     cc-options:        -fobjc-arc
17     frameworks:        Cocoa WebKit

The frameworks attribute instructs GHC to link the platform-native libraries Cocoa and WebKit, while cc-options: -fobjc-arc compiles the Objective-C source using Apple’s Automatic Reference Counting memory model.


Example 1: Hello World

The Hello World application demonstrates how to initialize a native window, inject CSS for a modern, glassmorphic card design, and launch the event loop.

Code Walkthrough (examples/HelloWorld.hs)

 1 {-# LANGUAGE OverloadedStrings #-}
 2 
 3 module Main where
 4 
 5 import WebKitHaskell
 6 
 7 main :: IO ()
 8 main = do
 9   putStrLn "Starting webkit-haskell Hello World example..."
10 
11   -- Create a 600x400 window
12   app <- newWebKitApp "Hello webkit-haskell" 600 400
13 
14   -- Beautiful inline HTML styled with glassmorphism and modern gradients
15   let html = "<!DOCTYPE html>\
16 \<html>\
17 \<head>\
18 \<meta charset='utf-8'>\
19 \<style>\
20 \  * { margin: 0; padding: 0; box-sizing: border-box; }\
21 \  body {\
22 \    font-family: -apple-system, BlinkMacSystemFont, 'Segoe UI', system-ui, sans-serif;\
23 \    background: linear-gradient(135deg, #0f0c29 0%, #302b63 50%, #24243e 100%);\
24 \    color: #e0e0e0;\
25 \    display: flex;\
26 \    align-items: center;\
27 \    justify-content: center;\
28 \    height: 100vh;\
29 \    overflow: hidden;\
30 \  }\
31 \  .card {\
32 \    text-align: center;\
33 \    background: rgba(255,255,255,0.05);\
34 \    backdrop-filter: blur(20px);\
35 \    -webkit-backdrop-filter: blur(20px);\
36 \    border: 1px solid rgba(255,255,255,0.1);\
37 \    border-radius: 24px;\
38 \    padding: 48px 64px;\
39 \    box-shadow: 0 8px 32px rgba(0,0,0,0.3);\
40 \    animation: fadeIn 0.8s ease-out;\
41 \  }\
42 \  @keyframes fadeIn {\
43 \    from { opacity: 0; transform: translateY(20px) scale(0.95); }\
44 \    to   { opacity: 1; transform: translateY(0) scale(1); }\
45 \  }\
46 \  h1 {\
47 \    font-size: 2.5em;\
48 \    font-weight: 700;\
49 \    background: linear-gradient(90deg, #a78bfa, #60a5fa, #34d399);\
50 \    -webkit-background-clip: text;\
51 \    -webkit-text-fill-color: transparent;\
52 \    margin-bottom: 12px;\
53 \  }\
54 \  p {\
55 \    font-size: 1.1em;\
56 \    color: rgba(255,255,255,0.6);\
57 \    line-height: 1.6;\
58 \  }\
59 \  .badge {\
60 \    display: inline-block;\
61 \    margin-top: 20px;\
62 \    padding: 6px 16px;\
63 \    font-size: 0.85em;\
64 \    background: rgba(167,139,250,0.15);\
65 \    border: 1px solid rgba(167,139,250,0.3);\
66 \    border-radius: 999px;\
67 \    color: #a78bfa;\
68 \  }\
69 \</style>\
70 \</head>\
71 \<body>\
72 \  <div class='card'>\
73 \    <h1>Hello, webkit-haskell!</h1>\
74 \    <p>A native macOS window powered by Haskell<br>\
75 \       and WebKit (WKWebView).</p>\
76 \    <span class='badge'>Haskell + Cocoa + WebKit</span>\
77 \  </div>\
78 \</body>\
79 \</html>"
80 
81   -- Load the HTML string directly into the WebView
82   loadHTML app html
83 
84   -- Run the Cocoa event loop (blocks main thread)
85   runWebKitApp app
86 
87   -- Clean up resources when terminated
88   destroyWebKitApp app
89   putStrLn "App loop terminated successfully."

Running the Example

Compile and run the Hello World executable using Cabal:

1 cabal run webkit-hello-world

This starts the application, opening a styled macOS window displaying the greeting card. Closing the window automatically terminates the process.


Example 2: Stateful Counter App

This example goes a step further by implementing a stateful, interactive counter showing bidirectional messaging. The frontend user interface contains buttons that trigger functions on the Haskell backend, updating a counter value stored in a stateful Haskell variable.

Code Walkthrough (examples/CounterApp.hs)

  1 {-# LANGUAGE OverloadedStrings #-}
  2 
  3 module Main where
  4 
  5 import WebKitHaskell
  6 import Data.IORef
  7 import qualified Data.Aeson as Aeson
  8 import qualified System.Info as SysInfo
  9 
 10 main :: IO ()
 11 main = do
 12   putStrLn "Starting webkit-haskell Counter App bridge example..."
 13 
 14   -- Create the window
 15   app <- newWebKitApp "Counter — webkit-haskell" 500 520
 16 
 17   -- Create mutable counter state using IORef
 18   counterRef <- newIORef (0 :: Int)
 19 
 20   -- Register bridge handlers
 21   registerHandler app "increment" $ \_payload -> do
 22     modifyIORef' counterRef (+ 1)
 23     val <- readIORef counterRef
 24     putStrLn $ "[Haskell] Handler 'increment' called. New count = " ++ show val
 25     return $ Aeson.object ["count" Aeson..= val]
 26 
 27   registerHandler app "decrement" $ \_payload -> do
 28     modifyIORef' counterRef (\x -> x - 1)
 29     val <- readIORef counterRef
 30     putStrLn $ "[Haskell] Handler 'decrement' called. New count = " ++ show val
 31     return $ Aeson.object ["count" Aeson..= val]
 32 
 33   registerHandler app "reset" $ \_payload -> do
 34     writeIORef counterRef 0
 35     putStrLn "[Haskell] Handler 'reset' called. Count reset to 0"
 36     return $ Aeson.object ["count" Aeson..= (0 :: Int)]
 37 
 38   registerHandler app "get-count" $ \_payload -> do
 39     val <- readIORef counterRef
 40     return $ Aeson.object ["count" Aeson..= val]
 41 
 42   registerHandler app "get-system-info" $ \_payload -> do
 43     putStrLn "[Haskell] Handler 'get-system-info' called."
 44     return $ Aeson.object
 45       [ "language" Aeson..= ("Haskell" :: String)
 46       , "version"  Aeson..= ("0.1.0" :: String)
 47       , "os"       Aeson..= SysInfo.os
 48       , "arch"     Aeson..= SysInfo.arch
 49       ]
 50 
 51   -- Beautiful UI with interactive counter controls
 52   let html = "<!DOCTYPE html>\
 53 \<html>\
 54 \<head>\
 55 \<meta charset='utf-8'>\
 56 \<style>\
 57 \  * { margin: 0; padding: 0; box-sizing: border-box; }\
 58 \  body {\
 59 \    font-family: -apple-system, BlinkMacSystemFont, system-ui, sans-serif;\
 60 \    background: #0a0a0a;\
 61 \    color: #fafafa;\
 62 \    display: flex;\
 63 \    flex-direction: column;\
 64 \    align-items: center;\
 65 \    justify-content: center;\
 66 \    height: 100vh;\
 67 \    gap: 32px;\
 68 \    user-select: none;\
 69 \    -webkit-user-select: none;\
 70 \  }\
 71 \  .counter-display {\
 72 \    font-size: 6rem;\
 73 \    font-weight: 800;\
 74 \    font-variant-numeric: tabular-nums;\
 75 \    letter-spacing: -4px;\
 76 \    background: linear-gradient(180deg, #fff 0%, rgba(255,255,255,0.5) 100%);\
 77 \    -webkit-background-clip: text;\
 78 \    -webkit-text-fill-color: transparent;\
 79 \    transition: transform 0.15s ease;\
 80 \    min-width: 200px;\
 81 \    text-align: center;\
 82 \  }\
 83 \  .counter-display.bump {\
 84 \    transform: scale(1.1);\
 85 \  }\
 86 \  .controls {\
 87 \    display: flex;\
 88 \    gap: 12px;\
 89 \  }\
 90 \  button {\
 91 \    font-size: 1.1rem;\
 92 \    font-weight: 600;\
 93 \    padding: 12px 28px;\
 94 \    border: none;\
 95 \    border-radius: 12px;\
 96 \    cursor: pointer;\
 97 \    transition: all 0.2s ease;\
 98 \    font-family: inherit;\
 99 \  }\
100 \  button:active {\
101 \    transform: scale(0.95);\
102 \  }\
103 \  .btn-primary {\
104 \    background: linear-gradient(135deg, #7c3aed, #a855f7);\
105 \    color: white;\
106 \    box-shadow: 0 4px 14px rgba(124,58,237,0.4);\
107 \  }\
108 \  .btn-primary:hover {\
109 \    box-shadow: 0 6px 20px rgba(124,58,237,0.6);\
110 \    transform: translateY(-1px);\
111 \  }\
112 \  .btn-primary:active {\
113 \    transform: scale(0.95) translateY(0);\
114 \  }\
115 \  .btn-danger {\
116 \    background: linear-gradient(135deg, #dc2626, #ef4444);\
117 \    color: white;\
118 \    box-shadow: 0 4px 14px rgba(220,38,38,0.3);\
119 \  }\
120 \  .btn-danger:hover {\
121 \    box-shadow: 0 6px 20px rgba(220,38,38,0.5);\
122 \    transform: translateY(-1px);\
123 \  }\
124 \  .btn-secondary {\
125 \    background: rgba(255,255,255,0.08);\
126 \    color: rgba(255,255,255,0.7);\
127 \    border: 1px solid rgba(255,255,255,0.1);\
128 \  }\
129 \  .btn-secondary:hover {\
130 \    background: rgba(255,255,255,0.12);\
131 \    color: white;\
132 \  }\
133 \  .info {\
134 \    font-size: 0.8rem;\
135 \    color: rgba(255,255,255,0.3);\
136 \    text-align: center;\
137 \    line-height: 1.6;\
138 \  }\
139 \  .info span {\
140 \    color: rgba(255,255,255,0.5);\
141 \  }\
142 \  h2 {\
143 \    font-size: 0.9rem;\
144 \    font-weight: 500;\
145 \    color: rgba(255,255,255,0.4);\
146 \    letter-spacing: 3px;\
147 \    text-transform: uppercase;\
148 \  }\
149 \</style>\
150 \</head>\
151 \<body>\
152 \  <h2>Counter</h2>\
153 \  <div class='counter-display' id='counter'>0</div>\
154 \  <div class='controls'>\
155 \    <button class='btn-danger' onclick='decrement()'>− Minus</button>\
156 \    <button class='btn-secondary' onclick='reset()'>Reset</button>\
157 \    <button class='btn-primary' onclick='increment()'>+ Plus</button>\
158 \  </div>\
159 \  <div class='info' id='info'>Loading backend system info...</div>\
160 \  <script>\
161 \    const display = document.getElementById('counter');\
162 \    const info = document.getElementById('info');\
163 \    function updateDisplay(count) {\
164 \      display.textContent = count;\
165 \      display.classList.add('bump');\
166 \      setTimeout(() => display.classList.remove('bump'), 150);\
167 \    }\
168 \    async function fn_init() {\
169 \      try {\
170 \        const result = await window.webkit_haskell.invoke('get-count', {});\
171 \        updateDisplay(result.count);\
172 \        const sysInfo = await window.webkit_haskell.invoke('get-system-info', {});\
173 \        info.innerHTML =\
174 \          'Backend: <span>' + sysInfo.language + ' v' + sysInfo.version + '</span>' +\
175 \          '<br>Platform: <span>' + sysInfo.os + ' (' + sysInfo.arch + ')</span>';\
176 \      } catch(e) {\
177 \        info.textContent = 'JS ↔ Haskell bridge connection failed';\
178 \      }\
179 \    }\
180 \    async function increment() {\
181 \      const result = await window.webkit_haskell.invoke('increment', {});\
182 \      updateDisplay(result.count);\
183 \    }\
184 \    async function decrement() {\
185 \      const result = await window.webkit_haskell.invoke('decrement', {});\
186 \      updateDisplay(result.count);\
187 \    }\
188 \    async function reset() {\
189 \      const result = await window.webkit_haskell.invoke('reset', {});\
190 \      updateDisplay(result.count);\
191 \    }\
192 \    setTimeout(fn_init, 200);\
193 \  </script>\
194 \</body>\
195 \</html>"
196 
197   loadHTML app html
198   runWebKitApp app
199   destroyWebKitApp app
200   putStrLn "App loop terminated successfully."

Explaining the Bidirectional State

  • In Haskell, we instantiate counterRef using newIORef (0 :: Int).
  • We register handlers for the commands "increment", "decrement", "reset", and "get-count".
  • Each handler uses modifyIORef' or writeIORef to update the counter, reads the new value, prints a debug line on stdout, and yields a JSON object wrapping the result (Aeson.object ["count" Aeson..= val]).
  • In the JavaScript frontend, the functions invoke these handlers asynchronously:
    1 const result = await window.webkit_haskell.invoke('increment', {});
    2 updateDisplay(result.count);
    
    This returns a JS Promise that resolves to the decoded JSON object returned by our Haskell module.

Running the Example

Run the Counter App via Cabal:

1 cabal run webkit-counter-app

Interact with the buttons. You will see both the counter value update in the visual display, and the debug log printing matching messages in your terminal.


Example 3: Markdown Viewer

The final example shows how to bridge file system access, dynamically listing and reading local text files from the user’s workspace, and displaying them in a split-pane layout.

Code Walkthrough (examples/MarkdownViewer.hs)

  1 {-# LANGUAGE OverloadedStrings #-}
  2 {-# LANGUAGE DeriveGeneric #-}
  3 {-# LANGUAGE ScopedTypeVariables #-}
  4 
  5 module Main where
  6 
  7 import WebKitHaskell
  8 import GHC.Generics (Generic)
  9 import System.Directory (listDirectory, doesFileExist, doesDirectoryExist)
 10 import System.FilePath (takeExtension, (</>))
 11 import Control.Monad (filterM)
 12 import Control.Exception (catch, SomeException)
 13 import qualified Data.Aeson as Aeson
 14 
 15 -- Request payload structure for reading a file
 16 newtype ReadFileRequest = ReadFileRequest
 17   { path :: String
 18   } deriving (Show, Generic)
 19 
 20 instance Aeson.FromJSON ReadFileRequest
 21 
 22 -- List markdown files in a directory
 23 listMdFiles :: FilePath -> IO [FilePath]
 24 listMdFiles dir = do
 25   exists <- doesDirectoryExist dir
 26   if not exists
 27     then return []
 28     else do
 29       entries <- listDirectory dir
 30       files <- filterM (\entry -> do
 31         let p = dir </> entry
 32         isFile <- doesFileExist p
 33         return (isFile && takeExtension p == ".md")
 34         ) entries
 35       return (map (dir </>) files)
 36 
 37 main :: IO ()
 38 main = do
 39   putStrLn "Starting webkit-haskell Markdown Viewer app..."
 40 
 41   -- Create a 900x700 window
 42   app <- newWebKitApp "Markdown Viewer — webkit-haskell" 900 700
 43 
 44   -- Register file listing handler
 45   registerHandler app "list-files" $ \_payload -> do
 46     let dir = "."
 47     putStrLn $ "[Haskell] Listing files in directory: " ++ dir
 48     currentFiles <- listMdFiles dir
 49     files <- if null currentFiles
 50                then do
 51                  putStrLn "[Haskell] No .md files in '.', checking 'webkit-haskell' subdirectory..."
 52                  listMdFiles "webkit-haskell"
 53                else return currentFiles
 54 
 55     return $ Aeson.object ["files" Aeson..= files]
 56 
 57   -- Register file reading handler
 58   registerHandler app "read-file" $ \payload -> do
 59     case Aeson.fromJSON payload of
 60       Aeson.Error err ->
 61         return $ Aeson.object ["error" Aeson..= ("Failed to parse request: " ++ err)]
 62       Aeson.Success (req :: ReadFileRequest) -> do
 63         let filePath = path req
 64         putStrLn $ "[Haskell] Reading file: " ++ filePath
 65         exists <- doesFileExist filePath
 66         if not exists
 67           then return $ Aeson.object ["error" Aeson..= ("File not found: " ++ filePath)]
 68           else do
 69             catch (do
 70               content <- readFile filePath
 71               return $ Aeson.object
 72                 [ "content" Aeson..= content
 73                 , "path" Aeson..= filePath
 74                 ])
 75               (\(e :: SomeException) ->
 76                 return $ Aeson.object ["error" Aeson..= show e])
 77 
 78   -- Beautiful UI with file selector sidebar and viewer pane
 79   let html = "<!DOCTYPE html>\
 80 \<html>\
 81 \<head>\
 82 \<meta charset='utf-8'>\
 83 \<style>\
 84 \  * { margin: 0; padding: 0; box-sizing: border-box; }\
 85 \  body {\
 86 \    font-family: -apple-system, BlinkMacSystemFont, system-ui, sans-serif;\
 87 \    background: #111;\
 88 \    color: #e5e5e5;\
 89 \    display: flex;\
 90 \    height: 100vh;\
 91 \  }\
 92 \  .sidebar {\
 93 \    width: 260px;\
 94 \    min-width: 260px;\
 95 \    background: #1a1a1a;\
 96 \    border-right: 1px solid rgba(255,255,255,0.06);\
 97 \    display: flex;\
 98 \    flex-direction: column;\
 99 \    overflow-y: auto;\
100 \  }\
101 \  .sidebar-header {\
102 \    padding: 20px 16px 12px;\
103 \    font-size: 0.75rem;\
104 \    font-weight: 600;\
105 \    letter-spacing: 2px;\
106 \    text-transform: uppercase;\
107 \    color: rgba(255,255,255,0.3);\
108 \  }\
109 \  .file-item {\
110 \    padding: 10px 16px;\
111 \    font-size: 0.9rem;\
112 \    cursor: pointer;\
113 \    color: rgba(255,255,255,0.6);\
114 \    transition: all 0.15s;\
115 \    border-left: 3px solid transparent;\
116 \  }\
117 \  .file-item:hover {\
118 \    background: rgba(255,255,255,0.04);\
119 \    color: white;\
120 \  }\
121 \  .file-item.active {\
122 \    background: rgba(124,58,237,0.1);\
123 \    color: #a78bfa;\
124 \    border-left-color: #7c3aed;\
125 \  }\
126 \  .file-item .name {\
127 \    font-weight: 500;\
128 \  }\
129 \  .file-item .path {\
130 \    font-size: 0.75rem;\
131 \    color: rgba(255,255,255,0.25);\
132 \    margin-top: 2px;\
133 \    white-space: nowrap;\
134 \    overflow: hidden;\
135 \    text-overflow: ellipsis;\
136 \  }\
137 \  .content {\
138 \    flex: 1;\
139 \    padding: 32px 48px;\
140 \    overflow-y: auto;\
141 \    font-size: 0.95rem;\
142 \    line-height: 1.7;\
143 \  }\
144 \  .content pre {\
145 \    background: rgba(255,255,255,0.04);\
146 \    border: 1px solid rgba(255,255,255,0.08);\
147 \    border-radius: 8px;\
148 \    padding: 16px 20px;\
149 \    overflow-x: auto;\
150 \    font-family: 'SF Mono', 'Fira Code', monospace;\
151 \    font-size: 0.85rem;\
152 \    white-space: pre-wrap;\
153 \    word-wrap: break-word;\
154 \    color: #c4b5fd;\
155 \  }\
156 \  .empty-state {\
157 \    display: flex;\
158 \    flex-direction: column;\
159 \    align-items: center;\
160 \    justify-content: center;\
161 \    height: 100%;\
162 \    color: rgba(255,255,255,0.2);\
163 \    font-size: 1.1rem;\
164 \    gap: 8px;\
165 \  }\
166 \  .empty-state .icon {\
167 \    font-size: 3rem;\
168 \    margin-bottom: 8px;\
169 \  }\
170 \</style>\
171 \</head>\
172 \<body>\
173 \  <div class='sidebar'>\
174 \    <div class='sidebar-header'>Markdown Files</div>\
175 \    <div id='file-list'>\
176 \      <div class='empty-state' style='height:200px;font-size:0.85rem;'>\
177 \        Loading workspace...\
178 \      </div>\
179 \    </div>\
180 \  </div>\
181 \  <div class='content' id='content'>\
182 \    <div class='empty-state'>\
183 \      <div class='icon'>📄</div>\
184 \      <div>Select a file to view</div>\
185 \      <div style='font-size:0.85rem;color:rgba(255,255,255,0.15)'>\
186 \        Markdown files fetched from the Haskell workspace filesystem\
187 \      </div>\
188 \    </div>\
189 \  </div>\
190 \  <script>\
191 \    const fileList = document.getElementById('file-list');\
192 \    const content = document.getElementById('content');\
193 \    function escapeHtml(str) {\
194 \      return str.replace(/&/g, '&amp;')\
195 \                .replace(/</g, '&lt;')\
196 \                .replace(/>/g, '&gt;');\
197 \    }\
198 \    function basename(path) {\
199 \      return path.split('/').pop().split('\\\\').pop();\
200 \    }\
201 \    async function loadFileList() {\
202 \      try {\
203 \        const result = await window.webkit_haskell.invoke('list-files', {});\
204 \        if (result.files && result.files.length > 0) {\
205 \          fileList.innerHTML = result.files.map(f => {\
206 \            const escapedPath = f.replace(/\\\\/g, '\\\\\\\\').replace(/'/g, \"\\\\'\");\
207 \            return '<div class=\"file-item\" onclick=\"loadFile(\\'' + escapedPath + '\\')\">' +\
208 \                   '<div class=\"name\">' + escapeHtml(basename(f)) + '</div>' +\
209 \                   '<div class=\"path\">' + escapeHtml(f) + '</div>' +\
210 \                   '</div>';\
211 \          }).join('');\
212 \        } else {\
213 \          fileList.innerHTML =\
214 \            '<div class=\"empty-state\" style=\"height:200px;font-size:0.85rem;\">' +\
215 \            'No .md files found</div>';\
216 \        }\
217 \      } catch(e) {\
218 \        fileList.innerHTML =\
219 \          '<div class=\"empty-state\" style=\"height:200px;font-size:0.85rem;\">' +\
220 \          'Error loading files: ' + e + '</div>';\
221 \      }\
222 \    }\
223 \    async function loadFile(path) {\
224 \      document.querySelectorAll('.file-item').forEach(el => {\
225 \        el.classList.remove('active');\
226 \        if (el.querySelector('.path').textContent === path) {\
227 \          el.classList.add('active');\
228 \        }\
229 \      });\
230 \      try {\
231 \        const result = await window.webkit_haskell.invoke('read-file', { path: path });\
232 \        if (result.error) {\
233 \          content.innerHTML = '<div class=\"empty-state\">' + escapeHtml(result.error) + '</div>';\
234 \        } else {\
235 \          content.innerHTML = '<pre>' + escapeHtml(result.content) + '</pre>';\
236 \        }\
237 \      } catch(e) {\
238 \        content.innerHTML = '<div class=\"empty-state\">Error loading file content</div>';\
239 \      }\
240 \    }\
241 \    setTimeout(loadFileList, 300);\
242 \  </script>\
243 \</body>\
244 \</html>"
245 
246   loadHTML app html
247   runWebKitApp app
248   destroyWebKitApp app
249   putStrLn "App loop terminated successfully."

Explaining the Generics Decoupling

In "read-file", the incoming argument is an Aeson.Value. We decode this value using:

1 case Aeson.fromJSON payload of

Rather than manually matching the underlying map representation of Aeson.Object (which differs between versions of the aeson library), we declare a simple ReadFileRequest type:

1 newtype ReadFileRequest = ReadFileRequest { path :: String } deriving (Show, Generic)
2 instance Aeson.FromJSON ReadFileRequest

This decouples the code from the version-specific details of the JSON library, making it extremely durable against future library upgrades.

Running the Example

Run the Markdown Viewer App via Cabal:

1 cabal run webkit-markdown-viewer

A window opens displaying the current workspace’s Markdown files in a side list. Selecting any file will read it from the local disk using Haskell’s readFile and update the view pane content asynchronously.

Optional Practice Problems

  1. Add a dark mode CSS toggle mechanism to the WebKit application using JS injection from Haskell.
  2. Register a message callback handler to capture window/document JavaScript errors and output them to GHC’s console stdout.