Change up a lot of stuff.

Add more functions to the plugin interface and write some generators to
generate an interface header file and the plugin's loading code.

3 files changed, 75 insertions, 27 deletions

diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
index 5ce93f0..e04cb49 100644
--- a/src/Wetterhorn/Core.hs
+++ b/src/Wetterhorn/Core.hs
@@ -11,14 +11,18 @@ module Wetterhorn.Core
     initWetterhorn,
     wio,
     incrementState,
+    readWState,
   )
 where
 
-import Control.Applicative
 import Control.Arrow (first)
-import Foreign (StablePtr, deRefStablePtr, freeStablePtr, newStablePtr)
+import Control.Exception
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as CH
+import Foreign (StablePtr, newStablePtr)
 
-type Wetterhorn = (StablePtr (WConfig, WState))
+-- This is this opaque state presented to the harness.
+type Wetterhorn = StablePtr (WConfig, WState)
 
 initWetterhorn :: WConfig -> IO Wetterhorn
 initWetterhorn conf = do
@@ -28,20 +32,20 @@ data WState = WState
   { someString :: String,
     integer :: Int
   }
+  deriving (Show, Read)
 
 data WConfig = WConfig
   { someConfig :: String,
     handleSomething :: W ()
   }
 
-foreign export ccall handle_thing :: StablePtr (WConfig, WState) -> IO (StablePtr (WConfig, WState))
-
-handle_thing :: StablePtr (WConfig, WState) -> IO (StablePtr (WConfig, WState))
-handle_thing ptr = do
-  (conf, st) <- deRefStablePtr ptr
-  (_, st') <- runW (handleSomething conf) (conf, st)
-  newStablePtr (conf, st')
-    <* freeStablePtr ptr
+readWState :: ByteString -> IO WState
+readWState bs =
+  catch
+    (return $ read (CH.unpack bs))
+    ( \e ->
+        let _ = (e :: SomeException) in return (WState "" 0)
+    )
 
 newtype W a = W ((WConfig, WState) -> IO (a, WState))
 
diff --git a/src/Wetterhorn/FFI.hs b/src/Wetterhorn/FFI.hs
new file mode 100644
index 0000000..c27c129
--- /dev/null
+++ b/src/Wetterhorn/FFI.hs
@@ -0,0 +1,55 @@
+-- | This module does not export anything. It exists simply to provide C-symbols
+-- for the plugin.
+module Wetterhorn.FFI() where
+
+import Control.Monad (forM_)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as CH
+import Foreign
+  ( Ptr,
+    Storable (poke, pokeByteOff),
+    Word32,
+    Word8,
+    deRefStablePtr,
+    freeStablePtr,
+    mallocBytes,
+    newStablePtr,
+  )
+import Foreign.C (CChar)
+import Wetterhorn.Core
+
+foreign import ccall wetterhorn :: IO Wetterhorn
+
+-- | This function is the implementation of the "hotstart" mechanism. It gives a
+-- pointer to the previously marshalled state and the length of that array and
+-- this function returns a Wetterhorn instance.
+foreign export ccall "plugin_hot_start"
+  pluginHotStart ::
+    Ptr CChar -> Word32 -> IO Wetterhorn
+
+pluginHotStart :: Ptr CChar -> Word32 -> IO Wetterhorn
+pluginHotStart chars len = do
+  bs <- BS.packCStringLen (chars, fromIntegral len)
+  wtrPtr <- wetterhorn
+  (conf, _) <- deRefStablePtr wtrPtr
+  freeStablePtr wtrPtr
+  newStablePtr . (conf,) =<< readWState bs
+
+foreign export ccall "plugin_cold_start"
+  pluginColdStart :: IO Wetterhorn
+
+pluginColdStart :: IO Wetterhorn
+pluginColdStart = wetterhorn
+
+foreign export ccall "plugin_marshal_state"
+  pluginMarshalState :: Wetterhorn -> Ptr Word32 -> IO (Ptr Word8)
+
+pluginMarshalState :: Wetterhorn -> Ptr Word32 -> IO (Ptr Word8)
+pluginMarshalState stblptr outlen = do
+  (_, st) <- deRefStablePtr stblptr
+  let bs = CH.pack (show st)
+  ret <- mallocBytes (BS.length bs)
+  poke outlen (fromIntegral $ BS.length bs)
+  forM_ (zip [0 ..] (BS.unpack bs)) $ \(off, w8) -> do
+    pokeByteOff ret off w8
+  return ret
diff --git a/src/harness_adapter.c b/src/harness_adapter.c
index dbae57a..15a2269 100644
--- a/src/harness_adapter.c
+++ b/src/harness_adapter.c
@@ -1,19 +1,8 @@
-#include <stdio.h>
 #include "HsFFI.h"
+#include "plugin_interface.h"
 
-typedef void* opst_t;
+const char *plugin_name = "Wetterhorn";
 
-extern opst_t wetterhorn();
-
-opst_t plugin_init(int* argc, char*** argv)
-{
-  hs_init(argc, argv);
-  return wetterhorn();
-}
-
-void plugin_teardown()
-{
-  hs_exit();
-}
-
-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(); }