[refactor] finish hooking together the plugin. It is now runnable.

4 files changed, 123 insertions, 14 deletions

diff --git a/CMakeLists.txt b/CMakeLists.txt
index 848c090..18348ae 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -19,6 +19,14 @@ add_custom_target(
   VERBATIM
 )
 
+add_custom_target(
+  run
+  COMMAND sh -c "PLUGIN_SO=$(find '${CMAKE_BINARY_DIR}/stack-work' -name montis.so -type f | head -n 1); if [ -z \"$PLUGIN_SO\" ]; then echo 'montis.so not found in ${CMAKE_BINARY_DIR}/stack-work' 1>&2; exit 1; fi; \"$<TARGET_FILE:montis>\" -s foot -p \"$PLUGIN_SO\""
+  DEPENDS montis plug_build
+  USES_TERMINAL
+  VERBATIM
+)
+
 
 install(TARGETS montis RUNTIME DESTINATION bin)
 
diff --git a/plug/src/Montis/Core/Internal/Foreign/Export.hs b/plug/src/Montis/Core/Internal/Foreign/Export.hs
index fc535c9..c3ab71f 100644
--- a/plug/src/Montis/Core/Internal/Foreign/Export.hs
+++ b/plug/src/Montis/Core/Internal/Foreign/Export.hs
@@ -3,6 +3,7 @@
 module Montis.Core.Internal.Foreign.Export () where
 
 import Control.Monad (forM_)
+import Control.Monad.State (MonadIO (liftIO), gets)
 import Data.ByteString qualified as BS
 import Data.ByteString.Char8 qualified as CH
 import Data.Singletons.Decide (Void)
@@ -17,10 +18,34 @@ import Foreign
     newStablePtr,
   )
 import Foreign.C (CChar, CInt (..))
-import Montis.Base.Foreign.WlRoots.Types (ForeignWlrXdgSurface, WlrEventKeyboardKey, WlrInputDevice, WlrPointerButtonEvent)
+import Montis.Base.Foreign.WlRoots.Types (ForeignSurface (toSurface), ForeignWlrInputDevice, ForeignWlrPointer, ForeignWlrXWaylandSurface, ForeignWlrXdgSurface, WlrEventKeyboardKey, WlrInputDevice (WlrInputDevice), WlrPointer (WlrPointer), WlrPointerButtonEvent)
 import Montis.Core
-import Montis.Core.State.Marshal (marshalState)
 import Montis.Core.State
+import Montis.Core.State.Marshal (marshalState)
+import Montis.Foreign.Marshal (Demarshal (Demarshal), demarshal, runDemarshal)
+
+runForeign ::
+  Montis () ->
+  OpqStT ->
+  IO OpqStT
+runForeign fn stableptr = do
+  (ctx, st) <- deRefStablePtr stableptr
+  freeStablePtr stableptr
+  (_, state') <- runMontis ctx st fn
+  newStablePtr (ctx, state')
+
+runForeignWithReturn ::
+  (Storable a) =>
+  Montis a ->
+  Ptr a ->
+  OpqStT ->
+  IO OpqStT
+runForeignWithReturn fn outptr stableptr = do
+  (ctx, st) <- deRefStablePtr stableptr
+  freeStablePtr stableptr
+  (val, state') <- runMontis ctx st fn
+  poke outptr val
+  newStablePtr (ctx, state')
 
 -- | Marshals the opaque state to a C-style byte array and size pointer.
 foreign export ccall "plugin_marshal_state"
@@ -40,11 +65,28 @@ foreign export ccall "plugin_handle_button"
   pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT
 
 pluginHandleButton :: Ptr WlrPointerButtonEvent -> Word32 -> OpqStT -> IO OpqStT
-pluginHandleButton = undefined
+pluginHandleButton eventPtr modifiers =
+  runForeign $ do
+    s <- gets currentHooks
+    event <- liftIO $
+      runDemarshal eventPtr $ do
+        pointerPtr <- demarshal :: Demarshal (Ptr ForeignWlrPointer)
+        tMs <- demarshal
+        button <- demarshal
+        state <- demarshal :: Demarshal Word8
+        return $
+          ButtonEvent
+            (WlrPointer pointerPtr)
+            tMs
+            button
+            modifiers
+            (if state == (0 :: Word8) then ButtonReleased else ButtonPressed)
+
+    buttonHook s event
 
 foreign export ccall "plugin_handle_keybinding"
   pluginHandleKeybinding ::
-    Ptr WlrInputDevice ->
+    Ptr ForeignWlrInputDevice ->
     Ptr WlrEventKeyboardKey ->
     Word32 ->
     Word32 ->
@@ -54,7 +96,7 @@ foreign export ccall "plugin_handle_keybinding"
     IO OpqStT
 
 pluginHandleKeybinding ::
-  Ptr WlrInputDevice ->
+  Ptr ForeignWlrInputDevice ->
   Ptr WlrEventKeyboardKey ->
   Word32 ->
   Word32 ->
@@ -62,24 +104,50 @@ pluginHandleKeybinding ::
   Ptr CInt ->
   OpqStT ->
   IO OpqStT
-pluginHandleKeybinding = undefined
+pluginHandleKeybinding inputDevicePtr eventPtr mods sym cp =
+  runForeignWithReturn $ do
+    s <- gets currentHooks
+    event <- liftIO $
+      runDemarshal eventPtr $ do
+        tMs <- demarshal
+        kc <- demarshal
+        _ <- (demarshal :: Demarshal Word32)
+        keyState <- demarshal
+        return $
+          KeyEvent
+            tMs
+            kc
+            (if keyState == (0 :: Word8) then KeyReleased else KeyPressed)
+            mods
+            sym
+            (toEnum $ fromIntegral cp)
+            (WlrInputDevice inputDevicePtr)
+
+    keyHook s event
+    return 1
 
 -- | Function exported to the harness to handle the mapping/unmapping/deletion
 -- of an XDG surface.
 foreign export ccall "plugin_handle_surface"
   pluginHandleSurface ::
-    Ptr Void -> CInt -> OpqStT -> IO OpqStT
+    Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT
 
 pluginHandleSurface ::
-  Ptr Void -> CInt -> OpqStT -> IO OpqStT
-pluginHandleSurface = undefined
+  Ptr ForeignWlrXdgSurface -> CInt -> OpqStT -> IO OpqStT
+pluginHandleSurface p t =
+  runForeign $ do
+    s <- gets currentHooks
+    surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p))
 
 -- | Function exported to the harness to handle the mapping/unmapping/deletion
 -- of an XWayland surface.
 foreign export ccall "plugin_handle_xwayland_surface"
   pluginHandleXWaylandSurface ::
-    Ptr Void -> CInt -> OpqStT -> IO OpqStT
+    Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT
 
 pluginHandleXWaylandSurface ::
-  Ptr Void -> CInt -> OpqStT -> IO OpqStT
-pluginHandleXWaylandSurface = undefined
+  Ptr ForeignWlrXWaylandSurface -> CInt -> OpqStT -> IO OpqStT
+pluginHandleXWaylandSurface p t =
+  runForeign $ do
+    s <- gets currentHooks
+    surfaceHook s (SurfaceEvent (toEnum $ fromIntegral t) (toSurface p))
diff --git a/plug/src/Montis/Core/Monad.hs b/plug/src/Montis/Core/Monad.hs
index 06cc0db..a2da111 100644
--- a/plug/src/Montis/Core/Monad.hs
+++ b/plug/src/Montis/Core/Monad.hs
@@ -25,12 +25,15 @@ type MontisState = State Montis
 -- OpqStT *is* the opq_st_t from the runtime code.
 type OpqStT = StablePtr (MontisContext, MontisState)
 
--- | THe Montis monad.
+-- | The Montis monad is a Reader over an immutable context plus a State over
+--   mutable runtime state, all ultimately running in IO for host effects.
 newtype Montis a where
   Montis :: (ReaderT MontisContext (StateT MontisState IO) a) -> Montis a
   deriving (Functor, Applicative, Monad, MonadState MontisState, MonadIO)
 
--- | Monad reader instance for Montis.
+-- | Reader access is scoped to the config portion of the full context; this
+--   keeps plugin code from mutating the context while still allowing read-only
+--   access to configuration.
 instance MonadReader MontisConfig Montis where
   ask :: Montis MontisConfig
   ask = Montis $ asks ctxConfig
@@ -42,6 +45,8 @@ instance MonadReader MontisConfig Montis where
   local cfn (Montis fn) =
     Montis $ local (\ctx -> ctx {ctxConfig = cfn (ctxConfig ctx)}) fn
 
+-- | Run a Montis action with a fixed context and initial state, returning the
+--   result value and the updated state.
 runMontis :: MontisContext -> MontisState -> Montis a -> IO (a, MontisState)
 runMontis ctx initState (Montis m) = runStateT (runReaderT m ctx) initState
 
@@ -55,11 +60,16 @@ defaultConfig =
             surfaceHook = liftIO . print,
             buttonHook = liftIO . print
           },
+      -- Default hooks are no-ops except for basic printing, which makes the
+      -- system usable without extra wiring during development.
       startupHook = return (),
       resetHook = return (),
+      -- Extensions start empty; callers can register config extensions as needed.
       configExtensions = mempty
     }
 
+-- | Store a typed extension in the extensible state map under its TypeRep.
+--   The value is wrapped so the map remains heterogeneously typed.
 xStatePut :: forall a. (StateExtension a) => a -> Montis ()
 xStatePut xst = do
   modify'
@@ -73,6 +83,9 @@ xStatePut xst = do
           }
     )
 
+-- | Retrieve a typed extension, demarshalling it if needed and caching it back.
+--   When the extension is stored in marshalled form, it is decoded and then
+--   reinserted so future lookups are fast.
 xStateGet :: forall a. (StateExtension a) => Montis (Maybe a)
 xStateGet = do
   mp <- gets extensibleState
diff --git a/plug/src/Montis/Foreign/Marshal.hs b/plug/src/Montis/Foreign/Marshal.hs
new file mode 100644
index 0000000..ed7b006
--- /dev/null
+++ b/plug/src/Montis/Foreign/Marshal.hs
@@ -0,0 +1,20 @@
+module Montis.Foreign.Marshal where
+
+import Control.Monad.State
+import Data.Word
+import Foreign (Ptr, Storable (sizeOf, peek), castPtr, plusPtr)
+
+type Offset = Word32
+
+newtype Demarshal a = Demarshal (StateT (Ptr ()) IO a)
+  deriving (Functor, Monad, Applicative, MonadState (Ptr ()))
+
+runDemarshal :: Ptr b -> Demarshal a -> IO a
+runDemarshal p (Demarshal dm) = evalStateT dm (castPtr p)
+
+demarshal :: (Storable a) => Demarshal a
+demarshal = do
+  ptr <- get
+  val <- Demarshal $ lift $ peek $ castPtr ptr
+  put (plusPtr ptr (sizeOf val))
+  return val