WIP: Working on the foreign interface.

3 files changed, 73 insertions, 10 deletions

diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
index 33ce78d..d3b3f56 100644
--- a/src/Wetterhorn/Core.hs
+++ b/src/Wetterhorn/Core.hs
@@ -14,6 +14,7 @@ module Wetterhorn.Core
     incrementState,
     readWState,
     defaultConfig,
+    requestHotReload,
   )
 where
 
@@ -24,13 +25,26 @@ import qualified Data.ByteString.Char8 as CH
 import Foreign (Ptr, StablePtr, Word32, newStablePtr, ptrToIntPtr)
 import Numeric (showHex)
 import Text.Printf
+import Wetterhorn.Core.ForeignInterface (ForeignInterface)
+import qualified Wetterhorn.Core.ForeignInterface as ForeignInterface
 
--- This is this opaque state presented to the harness.
-type Wetterhorn = StablePtr (WConfig, WState)
+data WContext = WContext
+  { ctxForeignInterface :: ForeignInterface,
+    ctxConfig :: WConfig
+  }
+
+-- This is the OpaqueState passed to the harness.
+type Wetterhorn = StablePtr (WContext, WState)
+
+requestHotReload :: W ()
+requestHotReload = do
+  fi <- ctxForeignInterface <$> getWContext
+  wio $ ForeignInterface.requestHotReload fi
 
 initWetterhorn :: WConfig -> IO Wetterhorn
 initWetterhorn conf = do
-  newStablePtr (conf, WState "this is a string" 0)
+  foreignInterface <- ForeignInterface.getForeignInterface
+  newStablePtr (WContext foreignInterface conf, WState "this is a string" 0)
 
 data WState = WState
   { someString :: String,
@@ -49,8 +63,8 @@ defaultConfig :: WConfig
 defaultConfig =
   WConfig
     { keybindingHandler = \sym -> do
-          i <- incrementState
-          wio (printf "[%d] Got key %d\n" i sym),
+        i <- incrementState
+        wio (printf "[%d] Got key %d\n" i sym),
       surfaceHandler = \state ptr -> wio (printf "Surface %s is %s\n" (showHex (ptrToIntPtr ptr) "") (show state))
     }
 
@@ -62,7 +76,7 @@ readWState bs =
         let _ = (e :: SomeException) in return (WState "" 0)
     )
 
-newtype W a = W ((WConfig, WState) -> IO (a, WState))
+newtype W a = W ((WContext, WState) -> IO (a, WState))
 
 instance Functor W where
   fmap mfn (W fn) = W $ fmap (first mfn) <$> fn
@@ -79,17 +93,20 @@ instance Monad W where
     let W fntob = fnmb a
     fntob (config, state')
 
+getWContext :: W WContext
+getWContext = W pure
+
 getWConfig :: W WConfig
-getWConfig = W pure
+getWConfig = ctxConfig <$> getWContext
 
 getWState :: W WState
 getWState = W $ \(_, s) -> pure (s, s)
 
-runW :: W a -> (WConfig, WState) -> IO (a, WState)
+runW :: W a -> (WContext, WState) -> IO (a, WState)
 runW (W fn) = fn
 
 incrementState :: W Int
-incrementState = W $ \(conf, WState s i) -> return (i, WState s (i + 1))
+incrementState = W $ \(_, 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/Core/ForeignInterface.hs b/src/Wetterhorn/Core/ForeignInterface.hs
new file mode 100644
index 0000000..acd98d6
--- /dev/null
+++ b/src/Wetterhorn/Core/ForeignInterface.hs
@@ -0,0 +1,36 @@
+module Wetterhorn.Core.ForeignInterface
+  ( getForeignInterface,
+    ForeignInterface (..),
+  )
+where
+
+import Data.Void (Void)
+import Foreign (Ptr, Storable (peekByteOff, sizeOf))
+import GHC.Exts (FunPtr)
+
+type CtxT = Ptr Void
+
+type ForeignCall = CtxT -> IO ()
+
+foreign import ccall "get_foreign_interface" foreignInterfacePtr :: IO (Ptr ())
+
+foreign import ccall "dynamic" toForeignCall :: FunPtr ForeignCall -> ForeignCall
+
+data ForeignInterface = ForeignInterface
+  { requestHotReload :: IO ()
+  }
+
+getForeignInterface :: IO ForeignInterface
+getForeignInterface = do
+  ptr <- foreignInterfacePtr
+
+  ctx <- peekByteOff ptr 0
+  requestHotReloadFn <- peekByteOff ptr (sizeOf ctx)
+
+  let _ = (ctx :: CtxT)
+  let _ = (requestHotReloadFn :: FunPtr ForeignCall)
+
+  return $
+    ForeignInterface
+      { requestHotReload = toForeignCall requestHotReloadFn ctx
+      }
diff --git a/src/harness_adapter.c b/src/harness_adapter.c
index 9684921..aa45ce6 100644
--- a/src/harness_adapter.c
+++ b/src/harness_adapter.c
@@ -9,7 +9,17 @@
 
 const char *plugin_name = "Wetterhorn";
 
-void plugin_load(int argc, char **argv) { hs_init(&argc, &argv); }
+void* foreign_interface;
+
+void* get_foreign_interface()
+{
+  return foreign_interface;
+}
+
+void plugin_load(int argc, char **argv, void* fintf) {
+  hs_init(&argc, &argv);
+  foreign_interface = fintf;
+}
 void plugin_teardown(opqst_t st) { hs_exit(); }
 
 static const char msg[] =