doesnt work

GypsFulvus.cabal

@@ -31,6 +31,7 @@ library
             -O2
             -threaded
             -with-rtsopts=-N
+            -g
 
 executable GypsFulvus
          default-language:    Haskell2010
@@ -47,6 +48,7 @@ executable GypsFulvus
             -O2
             -threaded
             -with-rtsopts=-N
+            -g
          hs-source-dirs:      src
          other-modules: GypsFulvus, GypsFulvus.PluginStuff
          main-is:             Main.hs

src/GypsFulvus.hs

@@ -7,6 +7,7 @@ import qualified Data.Text as T
 import Control.Concurrent(ThreadId, forkIO, killThread)
 import GypsFulvus.PluginStuff
 import Control.Monad(liftM,filterM)
+import Control.Monad.IO.Class
 import qualified Data.Map.Strict as M
 import Data.Hashable
 import qualified Control.Monad.Parallel as Par
@@ -14,7 +15,7 @@ import System.Plugins.Load
 data Placeholder = Placeholder
 data CommandMap = CommandMap (M.Map T.Text Placeholder)
 data CommandWorkspace = CommandWorkspace Placeholder
-data Sewer = Sewer (M.Map Int Manhole)
+data Sewer = Sewer {getSewerMap :: M.Map Int Manhole}
 
 
 srcPluginPath :: IO FilePath
@@ -22,6 +23,8 @@ srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
 binPluginPath :: IO FilePath
 binPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
 
+ioBinPluginPath :: IO FilePath
+ioBinPluginPath = getXdgDirectory XdgData "gypsfulvus/binplugins/io" >>= makeAbsolute
 
 configPath :: IO FilePath
 configPath = getXdgDirectory XdgConfig "gypsfulvus"
@@ -30,15 +33,18 @@ configPath = getXdgDirectory XdgConfig "gypsfulvus"
 
 assCallbackWithManholeInSewer
   :: Hashable a1 =>
-     TMVar (M.Map Int Manhole)
+     TMVar (Sewer)
-     -> a1 -> Manhole -> STM ()
+     -> a1 -> Manhole -> STM (TMVar Sewer)
 assCallbackWithManholeInSewer sewer callback_name callback_manhole = do
   sewer_old <- takeTMVar sewer
   h_cname <- return $ hash callback_name
-  putTMVar sewer $ M.insert h_cname callback_manhole sewer_old
+  let newSewer =Sewer $ M.insert h_cname callback_manhole (getSewerMap sewer_old)
+  putTMVar sewer $ newSewer
+  return sewer
+  
 lookupManholeInSewer s p = do
   s_l <- readTMVar s
-  return $ M.lookup (hash p) s_l
+  return $ M.lookup (hash p) (getSewerMap s_l)
   
 dispatchCommands sharedCommandWorkspace sharedTaskQueue = undefined
 -- broadcast ouputs from routines to all (interested) parties
@@ -64,35 +70,56 @@ runForever diediedie =
       if (isDone) then putStrLn "Exiting cleanly." else error "I escaped my eternal prison somehow." -- it shouldn't be possible for the else to be reached unless something melts down
 registerComms = undefined
 
+listDirectory' = listDirectory
+
+loadIOBackends :: TMVar (Sewer) -> IO ()
 loadIOBackends sewer = do
-  potentialPlugins <- binPluginPath >>= \pp -> listDirectory pp >>= \xs -> filterM (\sd -> doesDirectoryExist (pp ++ "/" ++ sd)) xs >>= \xs' -> return $ Par.mapM (\sd -> pp ++ "/" ++ sd) xs'
+  potentialPlugins <- do
-  Par.mapM (\pp -> atomically $ tryRegisterIOPlugin sewer pp) potentialPlugins
+    pp <- ioBinPluginPath
+    xs <- listDirectory pp
+    xs' <- filterM (\sd -> doesDirectoryExist (pp ++ "/" ++ sd)) xs
+    Par.mapM (\sind -> return $ ((pp ++ "/" ++ sind), sind)) xs'
+  Par.mapM (\(pp,sd) -> tryRegisterIOPlugin sewer pp sd) potentialPlugins
   return ()
   
-
+makeInputManhole :: TMVar(Sewer) -> String -> IO (Maybe Manhole)
 makeInputManhole s p = do
-  coreManhole <- lookupManholeInSewer s "core"
+  coreManhole <- atomically $ lookupManholeInSewer s "core"
   case coreManhole of
     Just cm -> do
       coreInputChan <- return $ getInputChan cm
-      pluginInputChan <- newTChan
+      pluginInputChan <- atomically $ newTChan
       return $ Just $ Manhole pluginInputChan coreInputChan
     Nothing -> return Nothing
 
-tryRegisterIOPlugin s p = do
+tryRegisterIOPlugin :: TMVar(Sewer) -> FilePath -> String -> IO InitStatus
-  im <- makeInputManhole s p
+tryRegisterIOPlugin s pp pn = do
+  im <- makeInputManhole s pn
   case im of
     Just im' -> do
-      assCallbackWithManholeInSewer s p im'
+--      let  initPluginLoad :: IO ( LoadStatus Module (Manhole -> IO InitStatus))
+      putStrLn $ pp ++ "/" ++ pn ++ ".o"
+      initPluginLoad <- load_ (pp ++ "/" ++ pn ++ ".o") ["/usr/lib","/usr","/home/pszczola/.stack","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/base-4.13.0.0","/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/base-4.13.0.0", "/home/pszczola/.stack/programs/x86_64-linux/ghc-tinfo6-8.8.4/lib/ghc-8.8.4/base-4.13.0.0/libHSbase-4.13.0.0-ghc8.8.4.so","/home/pszczola/Carrion-Plugin-IO-STDIO/.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.0.1.0/build/","/home/pszczola/Carrion-Plugin-IO-STDIO/.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.0.1.0/","/usr/lib/ghc-8.10.2/base-4.14.1.0/"] "initPlugin"
+      case initPluginLoad of
+        LoadSuccess m sym -> putStrLn "loaded symbol initPlugin for pn"
+        LoadFailure e -> mapM putStrLn e >> return ()
+--      initPlugin <- initPluginLoad
+      atomically $ assCallbackWithManholeInSewer s pn im'
       return GoodInitStatus
     Nothing -> return $ BadInitStatus $ T.pack "Catastrophic failure - core ejected."
 loadCoreCommands = undefined
 
+makeNewSewer coreManhole = do
+  emptySewer <- atomically $ newTMVar $ Sewer M.empty
+  atomically $ assCallbackWithManholeInSewer (emptySewer) "core" coreManhole
+  
+
 execMain :: IO ()
 execMain = do
   collectorChannel <- atomically newTChan -- normal channel for dumping any user input, this is the output channel for all plugins
   dumperChannel <- atomically newTChan -- uh this doesnt make any sense, every dings needs to have its own channel
-  
+  newSewer <- makeNewSewer $ Manhole collectorChannel dumperChannel
+  loadIOBackends newSewer
   canary <- atomically $ newTMVar False -- simple 'should I exit' canary
   
 --  forkIO $ loadCommsPlugins canary collectorChannel