Made some more complex state in Wetterhorn.

Things are still purely for testing as I figure out how best to handle
the ffi boundary, though things are starting to make sense.

4 files changed, 96 insertions, 15 deletions

diff --git a/src/Main.hs b/src/Main.hs
index c43ef13..2d15fce 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,14 +1,18 @@
+{-# HLINT ignore "Use camelCase" #-}
+
 module Main (main) where
 import Control.Monad.Writer (execWriter, MonadWriter (tell))
 
-foreign export ccall call_in :: IO ()
-call_in :: IO ()
-call_in = putStrLn $ execWriter $ do
-  tell "Yo,"
-  tell " This was "
-  tell "Called"
-  tell " From"
-  tell " C!!"
+import Wetterhorn.Core
+
+foreign export ccall wetterhorn :: IO Wetterhorn
+wetterhorn :: IO Wetterhorn
+wetterhorn =
+ initWetterhorn $
+   WConfig "This is a string"
+   (do
+      (WState str _) <- getWState
+      wio $ putStrLn $ "Handle something!!! :) " ++ str)
 
 main :: IO ()
 main = putStrLn "This should be dynamically linked!\n"
diff --git a/src/Wetterhorn/Core.hs b/src/Wetterhorn/Core.hs
new file mode 100644
index 0000000..a6064a0
--- /dev/null
+++ b/src/Wetterhorn/Core.hs
@@ -0,0 +1,71 @@
+{-# HLINT ignore "Use camelCase" #-}
+
+module Wetterhorn.Core
+  ( WState (..),
+    WConfig (..),
+    W,
+    getWConfig,
+    getWState,
+    runW,
+    Wetterhorn,
+    initWetterhorn,
+    wio,
+  )
+where
+
+import Control.Arrow (first)
+import Foreign (StablePtr, deRefStablePtr, freeStablePtr, newStablePtr)
+
+type Wetterhorn = (StablePtr (WConfig, WState))
+
+initWetterhorn :: WConfig -> IO Wetterhorn
+initWetterhorn conf = do
+  newStablePtr (conf, WState "this is a string" "this is another string")
+
+data WState = WState
+  { someString :: String,
+    someOtherString :: String
+  }
+
+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
+  freeStablePtr ptr
+  (_, st') <- runW (handleSomething conf) (conf, st)
+  newStablePtr (conf, st')
+
+newtype W a = W ((WConfig, WState) -> IO (a, WState))
+
+instance Functor W where
+  fmap mfn (W fn) = W $ fmap (first mfn) <$> fn
+
+instance Applicative W where
+  pure a = W $ \(_, s) -> return (a, s)
+  mfn <*> ma = do
+    fn <- mfn
+    fn <$> ma
+
+instance Monad W where
+  (W fntoa) >>= fnmb = W $ \(config, state) -> do
+    (a, state') <- fntoa (config, state)
+    let W fntob = fnmb a
+    fntob (config, state')
+
+getWConfig :: W WConfig
+getWConfig = W pure
+
+getWState :: W WState
+getWState = W $ \(_, s) -> pure (s, s)
+
+runW :: W a -> (WConfig, WState) -> IO (a, WState)
+runW (W fn) = fn
+
+wio :: IO a -> W a
+wio fn = W $ \(_, b) -> fn >>= \a -> return (a, b)
diff --git a/src/harness/main.c b/src/harness/main.c
index 6666e5e..fd70e5f 100644
--- a/src/harness/main.c
+++ b/src/harness/main.c
@@ -4,6 +4,8 @@
 
 typedef void* dllib_t;
 
+typedef void* opqst_t;
+
 dllib_t open_library(const char* library, int* err)
 {
   dllib_t lib = dlopen(library, RTLD_LAZY);
@@ -31,18 +33,17 @@ void use_library(int argc, char** argv, dllib_t lib, int* err)
 {
   *err = 0;
 
-  void (*init)(int* argc, char*** argv) = getsym(lib, "plugin_init", err);
+  opqst_t (*init)(int* argc, char*** argv) = getsym(lib, "plugin_init", err);
   void (*teardown)() = getsym(lib, "plugin_teardown", err);
-  void (*sym)() = getsym(lib, "call_in", err);
+  opqst_t (*sym)(opqst_t) = getsym(lib, "handle_thing", err);
 
-  if (!sym) {
-    *err = 1;
+  if (*err) {
     fprintf(stderr, "Unable to find symbol call_in.\n");
     return;
   }
 
-  init(&argc, &argv);
-  sym();
+  opqst_t st = init(&argc, &argv);
+  st = sym(st);
   teardown();
 }
 
diff --git a/src/harness_adapter.c b/src/harness_adapter.c
index 9cd8118..4d751c0 100644
--- a/src/harness_adapter.c
+++ b/src/harness_adapter.c
@@ -1,9 +1,14 @@
 #include <stdio.h>
 #include "HsFFI.h"
 
-void plugin_init(int* argc, char*** argv)
+typedef void* opst_t;
+
+extern opst_t wetterhorn();
+
+opst_t plugin_init(int* argc, char*** argv)
 {
   hs_init(argc, argv);
+  return wetterhorn();
 }
 
 void plugin_teardown()