Added event handlers for map/unmap/destroy surfaces, added Alt+F5 for hot reload.

It turns out I could actually remove the metaload handler from the
plugin interface. As things turn out, when fully unloading the shared
object and reloading it, the Haskell runtime no longer complained. This
makes things much simpler, which is great.

I do wonder if I'm going to run into issues because of this, but I'll
cross that bridge when it's burning.

8 files changed, 110 insertions, 37 deletions

diff --git a/harness/include/plugin.h b/harness/include/plugin.h
index 651e2f1..7cee511 100644
--- a/harness/include/plugin.h
+++ b/harness/include/plugin.h
@@ -47,15 +47,6 @@ typedef struct PLUGIN {
    * will be NULL. */
   const char *plugin_name;
 
-  /**
-   * This is the first thing called on the plugin when loading it. This is
-   * different from plugin_load in that it will not be called on a hot-reload.
-   *
-   * This is used as a hack to get around GHC's limitation where it can't
-   * start up the RTS once it has been shutdown.
-   */
-  EXPORT(void (*plugin_metaload)(int argc, char** argv));
-
   /** Intializes the plugin with the given argc/argv. This is the first thing
    * called on the plugin and is called immediately after the library is loaded.
    */
@@ -97,6 +88,13 @@ typedef struct PLUGIN {
    */
   EXPORT(opqst_t (*plugin_handle_keybinding)(uint32_t keysym, opqst_t state));
 
+  /*
+   * Handles a surface being mapped, unmapped or destroyed.
+   */
+  EXPORT(opqst_t (*plugin_handle_surface_map)(void* surface, opqst_t));
+  EXPORT(opqst_t (*plugin_handle_surface_unmap)(void* surface, opqst_t));
+  EXPORT(opqst_t (*plugin_handle_surface_destroy)(void* surface, opqst_t));
+
 } plugin_t;
 
 /** Loads a plugin from the dynamic library handle. Returns a non-zero error
@@ -109,10 +107,10 @@ int load_plugin_from_dl(dlhandle_t library, plugin_t *out);
  * This function will call dlclose on the plugin's library handle if it is not
  * the same as 'library'.
  */
-int plugin_hot_reload(int argc, char **argv, dlhandle_t library,
+int plugin_hot_reload(int argc, char **argv, const char* filepath,
                       plugin_t *plugin);
 
 /* Reads a plugin from a filename. */
-int read_plugin_from_file(const char *filename, plugin_t *plugin);
+int load_plugin_from_file(const char *filename, plugin_t *plugin);
 
 #endif /* _PLUGIN_H_ */
diff --git a/harness/src/main.c b/harness/src/main.c
index 336cafe..995d11e 100644
--- a/harness/src/main.c
+++ b/harness/src/main.c
@@ -65,11 +65,10 @@ int main_(int argc, char **argv) {
   }
 
   plugin_t plugin;
-  if (read_plugin_from_file(argv[1], &plugin)) {
+  if (load_plugin_from_file(argv[1], &plugin)) {
     fprintf(stderr, "Exiting due to other failures.\n");
     return 1;
   }
-  plugin.plugin_metaload(argc, argv);
   plugin.plugin_load(argc, argv);
   plugin.state = plugin.plugin_cold_start();
 
diff --git a/harness/src/plugin.c b/harness/src/plugin.c
index d71608a..6344f4a 100644
--- a/harness/src/plugin.c
+++ b/harness/src/plugin.c
@@ -37,7 +37,7 @@ static void shx(uint8_t *state, uint32_t sz) {
   }
 }
 
-int read_plugin_from_file(const char *filename, plugin_t *plugin) {
+int load_plugin_from_file(const char *filename, plugin_t *plugin) {
   dlhandle_t lib = dlopen(filename, RTLD_LAZY);
 
   if (!lib) {
@@ -49,7 +49,7 @@ int read_plugin_from_file(const char *filename, plugin_t *plugin) {
   return load_plugin_from_dl(lib, plugin);
 }
 
-int plugin_hot_reload(int argc, char **argv, dlhandle_t library,
+int plugin_hot_reload(int argc, char **argv, const char* filepath,
                       plugin_t *plugin) {
   int ec = 0;
   uint32_t sz = 0;
@@ -67,12 +67,10 @@ int plugin_hot_reload(int argc, char **argv, dlhandle_t library,
   printf("State Marshalled:\n");
   shx(marshalled_state, sz);
 
-  if (library != plugin->library_handle) {
-    printf("Unloading old library handle.\n");
-    dlclose(plugin->library_handle);
-  }
+  printf("Unloading old library handle.\n");
+  dlclose(plugin->library_handle);
 
-  if ((ec = load_plugin_from_dl(library, plugin))) {
+  if ((ec = load_plugin_from_file(filepath, plugin))) {
     goto fail;
   }
 
diff --git a/harness/src/wl.c b/harness/src/wl.c
index aac2bf8..5fa1395 100644
--- a/harness/src/wl.c
+++ b/harness/src/wl.c
@@ -24,6 +24,23 @@
 #include <wlr/util/log.h>
 #include <xkbcommon/xkbcommon.h>
 
+// This macro is responsible for calling a handler on a plugin. This macro will
+// acquire the plugin's lock, call the member with the arguments and update the
+// state.
+//
+// This only works on function which have the format:
+//
+// opqst_t function(args ..., opqst_t state);
+//
+// Note that the state parameter is omitted from this macro.
+#define plugin_call_update_state(plugin, member, ...)                          \
+  do {                                                                         \
+    plugin_t *pl__ = &(plugin);                                                \
+    pthread_mutex_lock(&pl__->lock);                                           \
+    pl__->state = pl__->member(__VA_ARGS__, pl__->state);                      \
+    pthread_mutex_unlock(&pl__->lock);                                         \
+  } while (0)
+
 /* For brevity's sake, struct members are annotated where they are used. */
 enum tinywl_cursor_mode {
   TINYWL_CURSOR_PASSTHROUGH,
@@ -63,6 +80,9 @@ struct tinywl_server {
   struct wl_list outputs;
   struct wl_listener new_output;
 
+  int plugin_argc;
+  char **plugin_argv;
+  const char *plugin_fpath;
   plugin_t plugin;
 };
 
@@ -152,8 +172,7 @@ static void keyboard_handle_modifiers(struct wl_listener *listener,
 }
 
 static bool handle_keybinding(struct tinywl_server *server, xkb_keysym_t sym) {
-  server->plugin.state =
-      server->plugin.plugin_handle_keybinding(sym, server->plugin.state);
+  plugin_call_update_state(server->plugin, plugin_handle_keybinding, sym);
   /*
    * Here we handle compositor keybindings. This is when the compositor is
    * processing keys, rather than passing them on to the client for its own
@@ -161,10 +180,15 @@ static bool handle_keybinding(struct tinywl_server *server, xkb_keysym_t sym) {
    *
    * This function assumes Alt is held down.
    */
+  dlhandle_t new_handle;
   switch (sym) {
   case XKB_KEY_Escape:
     wl_display_terminate(server->wl_display);
     break;
+  case XKB_KEY_F5:
+    plugin_hot_reload(server->plugin_argc, server->plugin_argv,
+                      server->plugin_fpath, &server->plugin);
+    break;
   case XKB_KEY_F1:
     /* Cycle to the next view */
     if (wl_list_length(&server->views) < 2) {
@@ -699,6 +723,8 @@ static void server_new_output(struct wl_listener *listener, void *data) {
 static void xdg_surface_map(struct wl_listener *listener, void *data) {
   /* Called when the surface is mapped, or ready to display on-screen. */
   struct tinywl_view *view = wl_container_of(listener, view, map);
+  plugin_call_update_state(view->server->plugin, plugin_handle_surface_map,
+                           data);
   view->mapped = true;
   focus_view(view, view->xdg_surface->surface);
 }
@@ -706,12 +732,16 @@ static void xdg_surface_map(struct wl_listener *listener, void *data) {
 static void xdg_surface_unmap(struct wl_listener *listener, void *data) {
   /* Called when the surface is unmapped, and should no longer be shown. */
   struct tinywl_view *view = wl_container_of(listener, view, unmap);
+  plugin_call_update_state(view->server->plugin, plugin_handle_surface_unmap,
+                           data);
   view->mapped = false;
 }
 
 static void xdg_surface_destroy(struct wl_listener *listener, void *data) {
   /* Called when the surface is destroyed and should never be shown again. */
   struct tinywl_view *view = wl_container_of(listener, view, destroy);
+  plugin_call_update_state(view->server->plugin, plugin_handle_surface_destroy,
+                           data);
   wl_list_remove(&view->link);
   free(view);
 }
@@ -842,14 +872,17 @@ int main(int argc, char *argv[]) {
 
   struct tinywl_server server;
 
-  if (read_plugin_from_file(plugin, &server.plugin)) {
+  if (load_plugin_from_file(plugin, &server.plugin)) {
     fprintf(stderr, "Failed to read plugin from file.\n");
     return 1;
   }
 
-  server.plugin.plugin_metaload(argc, argv);
+  // server.plugin.plugin_metaload(argc, argv);
   server.plugin.plugin_load(argc, argv);
   server.plugin.state = server.plugin.plugin_cold_start();
+  server.plugin_fpath = plugin;
+  server.plugin_argv = argv;
+  server.plugin_argc = argc;
 
   /* The Wayland display is managed by libwayland. It handles accepting
    * clients from the Unix socket, manging Wayland globals, and so on. */
diff --git a/src/Main.hs b/src/Main.hs
index 75e21bd..03b5018 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -10,13 +10,8 @@ foreign export ccall wetterhorn :: IO Wetterhorn
 
 wetterhorn :: IO Wetterhorn
 wetterhorn =
-  initWetterhorn $
-    WConfig
-      "This is a string"
-      ( \sym -> do
-          wio $
-            printf "Got Key: %x\n" sym
-      )
+  initWetterhorn
+    defaultConfig
 
 main :: IO ()
 main = putStrLn "This should be dynamically linked!\n"
diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
index 7b5690f..7a5c0b1 100644
--- a/src/Wetterhorn/Core.hs
+++ b/src/Wetterhorn/Core.hs
@@ -3,6 +3,7 @@
 module Wetterhorn.Core
   ( WState (..),
     WConfig (..),
+    SurfaceState (..),
     W,
     getWConfig,
     getWState,
@@ -12,6 +13,7 @@ module Wetterhorn.Core
     wio,
     incrementState,
     readWState,
+    defaultConfig,
   )
 where
 
@@ -19,7 +21,9 @@ import Control.Arrow (first)
 import Control.Exception
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as CH
-import Foreign (StablePtr, Word32, newStablePtr)
+import Foreign (Ptr, StablePtr, Word32, newStablePtr, ptrToIntPtr)
+import Numeric (showHex)
+import Text.Printf
 
 -- This is this opaque state presented to the harness.
 type Wetterhorn = StablePtr (WConfig, WState)
@@ -34,11 +38,22 @@ data WState = WState
   }
   deriving (Show, Read)
 
+data SurfaceState = Map | Unmap | Destroy deriving (Eq, Ord, Show, Enum)
+
 data WConfig = WConfig
-  { someConfig :: String,
-    keybindingHandler :: Word32 -> W ()
+  { keybindingHandler :: Word32 -> W (),
+    surfaceHandler :: SurfaceState -> Ptr () -> W ()
   }
 
+defaultConfig :: WConfig
+defaultConfig =
+  WConfig
+    { keybindingHandler = \sym -> do
+          i <- incrementState
+          wio (printf "[%d] Got key yolol %d\n" i sym),
+      surfaceHandler = \state ptr -> wio (printf "Surface %s is %s\n" (showHex (ptrToIntPtr ptr) "") (show state))
+    }
+
 readWState :: ByteString -> IO WState
 readWState bs =
   catch
@@ -73,8 +88,8 @@ getWState = W $ \(_, s) -> pure (s, s)
 runW :: W a -> (WConfig, WState) -> IO (a, WState)
 runW (W fn) = fn
 
-incrementState :: W ()
-incrementState = W $ \(conf, WState s i) -> return ((), WState s (i + 1))
+incrementState :: W Int
+incrementState = W $ \(conf, WState s i) -> return (i, WState s (i + 1))
 
 wio :: IO a -> W a
 wio fn = W $ \(_, b) -> fn >>= \a -> return (a, b)
diff --git a/src/Wetterhorn/FFI.hs b/src/Wetterhorn/FFI.hs
index d941493..1463396 100644
--- a/src/Wetterhorn/FFI.hs
+++ b/src/Wetterhorn/FFI.hs
@@ -25,6 +25,23 @@ runForeign fn stblptr = do
   (_, state') <- runW (fn conf) (conf, st)
   newStablePtr (conf, state')
 
+runForeignWithReturn :: (Storable a) => (WConfig -> W a) -> Ptr a -> Wetterhorn -> IO Wetterhorn
+runForeignWithReturn fn ptr stableptr = do
+  (conf, st) <- deRefStablePtr stableptr
+  freeStablePtr stableptr
+  (val, state') <- runW (fn conf) (conf, st)
+  poke ptr val
+  newStablePtr (conf, state')
+
+runForeignWithReturn2 :: (Storable a, Storable b) => (WConfig -> W (a, b)) -> Ptr a -> Ptr b -> Wetterhorn -> IO Wetterhorn
+runForeignWithReturn2 fn ptrA ptrB stableptr = do
+  (conf, st) <- deRefStablePtr stableptr
+  freeStablePtr stableptr
+  ((vA, vB), state') <- runW (fn conf) (conf, st)
+  poke ptrA vA
+  poke ptrB vB
+  newStablePtr (conf, state')
+
 -- | This function should be defined somewhere in the code. This is kind of like
 -- the "main" function in XMonad.
 foreign import ccall wetterhorn :: IO Wetterhorn
@@ -73,3 +90,22 @@ foreign export ccall "plugin_handle_keybinding"
 
 pluginHandleKeybinding :: Word32 -> Wetterhorn -> IO Wetterhorn
 pluginHandleKeybinding sym = runForeign (`keybindingHandler` sym)
+
+foreign export ccall "plugin_handle_surface_map"
+  pluginHandleSurfaceMap ::
+    Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceMap :: Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceMap p = runForeign (\c -> surfaceHandler c Map p)
+
+foreign export ccall "plugin_handle_surface_unmap"
+  pluginHandleSurfaceUnmap ::
+    Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceUnmap :: Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceUnmap p = runForeign (\c -> surfaceHandler c Unmap p)
+
+
+foreign export ccall "plugin_handle_surface_destroy"
+  pluginHandleSurfaceDestroy ::
+    Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceDestroy :: Ptr () -> Wetterhorn -> IO Wetterhorn
+pluginHandleSurfaceDestroy p = runForeign (\c -> surfaceHandler c Destroy p)
diff --git a/src/harness_adapter.c b/src/harness_adapter.c
index 82e8caf..5a9b9a4 100644
--- a/src/harness_adapter.c
+++ b/src/harness_adapter.c
@@ -9,5 +9,4 @@
 const char *plugin_name = "Wetterhorn";
 
 void plugin_load(int argc, char **argv) { hs_init(&argc, &argv); }
-void plugin_metaload(int argc, char **argv) { hs_init(&argc, &argv); }
 void plugin_teardown(opqst_t st) { hs_exit(); }