update API again.. provide utils

GypsFulvus.cabal

@@ -24,7 +24,8 @@ library
                        containers,
                        text,
                        plugins >= 1.6.0,
-                       directory
+                       directory,
+                       hashable
          ghc-options:
             -O2
             -threaded
@@ -38,7 +39,8 @@ executable GypsFulvus
                        containers,
                        text,
                        plugins >= 1.6.0,
-                       directory
+                       directory,
+                       hashable
          ghc-options:
             -O2
             -threaded

src/GypsFulvus.hs

@@ -1,17 +1,40 @@
-module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
+module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, regift,stripCommandPrefix',inspectManhole) where
-import Control.Concurrent.STM (atomically, retry)
+import Control.Concurrent.STM
 import Control.Concurrent.STM.TMVar
 import Control.Concurrent.STM.TChan
-import qualified Data.Map as M
+import System.Directory
 import qualified Data.Text as T
 import Control.Concurrent(ThreadId, forkIO, killThread)
 import GypsFulvus.PluginStuff
 import Control.Monad(liftM)
+import qualified Data.Map.Strict as M
+import Data.Hashable
 data Placeholder = Placeholder
 data CommandMap = CommandMap (M.Map T.Text Placeholder)
 data CommandWorkspace = CommandWorkspace Placeholder
+data Sewer = Sewer (M.Map Int Manhole)
 
 
+srcPluginPath :: IO FilePath
+srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
+binPluginPath :: IO FilePath
+binPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
+
+
+configPath :: IO FilePath
+configPath = getXdgDirectory XdgConfig "gypsfulvus"
+
+
+
+assCallbackWithManholeInSewer
+  :: Hashable a1 =>
+     TMVar (M.Map Int a2 -> M.Map Int a2)
+     -> a1 -> a2 -> STM ()
+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
+  
 dispatchCommands sharedCommandWorkspace sharedTaskQueue = undefined
 -- broadcast ouputs from routines to all (interested) parties
 broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQueue = undefined
@@ -19,6 +42,11 @@ broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQ
 collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue = undefined
 
         
+-- load all the routines that the bot can run (e.g. run tcl code, calculator, youtube, etc.)
+loadLabourPlugins availableCommandMap = undefined
+-- thread to pass any work to be done
+
+
 runForever :: TMVar Bool -> IO ()
 runForever diediedie =
   let block = do
@@ -31,14 +59,18 @@ 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
 
-
+loadIOBackends sewer = undefined
+loadCoreCommands = undefined
 
 execMain :: IO ()
 execMain = do
-  collectorChannel <- atomically newTChan -- normal channel for dumping any user input
+  collectorChannel <- atomically newTChan -- normal channel for dumping any user input, this is the output channel for all plugins
-  consumerBroadcastChannel <- atomically newBroadcastTChan
+  dumperChannel <- atomically newTChan -- uh this doesnt make any sense, every dings needs to have its own channel
+
   canary <- atomically $ newTMVar False -- simple 'should I exit' canary
-  forkIO $ loadCommsPlugins canary collectorChannel
+  
+--  forkIO $ loadCommsPlugins canary collectorChannel
+  
 --  availableCommandMap <- atomically $ newTMVar CommandMap
 --  loadLabourPlugins availableCommandMap
 --  sharedCommandWorkspace <- atomically $ newTMVar CommandWorkspace
@@ -50,3 +82,26 @@ execMain = do
   let myTIDs  = []
   runForever canary
   mapM_ killThread myTIDs
+
+
+
+
+--makePluginsForgetThis canary collectorChannel =
+--  let potentialPlugins = srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> doesDirectoryExist (pp ++ "/" ++ fuku)) >>= mapM (\fuku -> return (pp ++ "/" ++ fuku))
+--  in do
+--    srcPluginPath >>= putStrLn
+--    srcPluginPath >>= listDirectory >>= mapM putStrLn
+--    srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> putStrLn (pp ++ "/" ++ fuku) >> doesDirectoryExist (pp ++ "/" ++ fuku)) 
+--    pp <- potentialPlugins
+--    mapM_ putStrLn pp
+--    ff <- mapM (\d -> findFile [d] "Plugin.hs") pp
+--    let rff = map (fromMaybe "") $ filter (/= Nothing) ff
+--    s <- mapM (\hng -> makeAll hng ["-v","-dynamic"]) rff
+--    mapM (\s' -> case s' of
+--                   MakeSuccess _ p -> putStrLn p
+--                   MakeFailure e -> putStrLn $ show e) s
+--    _ <- atomically $ swapTMVar canary True
+    -- I don't actually want to quit here but I don't like errors from STM heuristics when the canary is GCed
+    
+--    return ()
+-- end makePluginsForgetThis

src/GypsFulvus/PluginStuff.hs

@@ -1,11 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
-module GypsFulvus.PluginStuff(loadCommsPlugins, Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
+module GypsFulvus.PluginStuff(Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, inspectManhole, regift, stripCommandPrefix') where
 import Control.Monad
-import System.Directory
+
 import System.Plugins.Make
 import Data.Maybe
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TMVar
+import qualified Data.List as L
 import qualified Data.Text as T
 
 (♯) :: T.Text -> T.Text -> T.Text
@@ -13,7 +14,18 @@ a ♯ b = (T.append) a b
 
 tooTeToSt :: T.Text -> T.Text -> String
 tooTeToSt a b = tup $ a ♯ "@" ♯ b
-
+stripCommandPrefix
+  :: T.Text -> [T.Text] -> Either [Maybe T.Text] (Maybe T.Text)
+stripCommandPrefix c = uniqueHit . filter (/= Nothing) . map (\cs -> T.stripPrefix cs (c ♯ " "))
+  where
+    uniqueHit cs = if (L.length cs == (1 :: Int)) then Right $ head cs else Left cs
+stripCommandPrefix'
+  :: T.Text -> [T.Text] -> Manhole -> SewageAutorInfo -> IO (Maybe T.Text)
+stripCommandPrefix' c ccs m sig = case stripCommandPrefix c ccs of
+  Right c -> return c
+  Left cs -> do
+    sew <- regift (Sewage sig (if L.null cs then ("No such command: " ♯ c) else ("Found multiple matching commands: " ♯ ((L.foldr1 (\h ng  -> h ♯ ", " ♯ ng)) $ (map (fromMaybe "")) cs)))) m
+    return Nothing
 tp :: String -> T.Text
 tp = T.pack
 tup :: T.Text -> String
@@ -62,40 +74,7 @@ data Manhole = Manhole {
                        getOutputChan :: TChan Sewage}
 data InitStatus = GoodInitStatus | BadInitStatus T.Text
 
-srcPluginPath :: IO FilePath
+inspectManhole :: Manhole -> IO Sewage
-srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
+inspectManhole = atomically . readTChan . getInputChan
-
+regift :: Sewage -> Manhole -> IO ()
-
+regift g = atomically . (flip writeTChan g) . getOutputChan
-configPath :: IO FilePath
-configPath = getXdgDirectory XdgConfig "gypsfulvus"
-
-
-
-
--- load all the plugins for IO (e.g. IRC, stdio, maybe matrix procol, telnet, whatever)
-
-
-
-loadCommsPlugins canary collectorChannel =
-  let potentialPlugins = srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> doesDirectoryExist (pp ++ "/" ++ fuku)) >>= mapM (\fuku -> return (pp ++ "/" ++ fuku))
-  in do
-    srcPluginPath >>= putStrLn
-    srcPluginPath >>= listDirectory >>= mapM putStrLn
-    srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> putStrLn (pp ++ "/" ++ fuku) >> doesDirectoryExist (pp ++ "/" ++ fuku)) 
-    pp <- potentialPlugins
-    mapM_ putStrLn pp
-    ff <- mapM (\d -> findFile [d] "Plugin.hs") pp
-    let rff = map (fromMaybe "") $ filter (/= Nothing) ff
-    s <- mapM (\hng -> makeAll hng ["-v","-dynamic"]) rff
-    mapM (\s' -> case s' of
-                   MakeSuccess _ p -> putStrLn p
-                   MakeFailure e -> putStrLn $ show e) s
-    _ <- atomically $ swapTMVar canary True
-    -- I don't actually want to quit here but I don't like errors from STM heuristics when the canary is GCed
-    
-    return ()
-
-        
--- load all the routines that the bot can run (e.g. run tcl code, calculator, youtube, etc.)
-loadLabourPlugins availableCommandMap = undefined
--- thread to pass any work to be done