try to build all plugins
This commit is contained in:
@ -6,6 +6,7 @@ import qualified Data.Map as M
|
||||
import qualified Data.Text as T
|
||||
import Control.Concurrent(ThreadId, forkIO, killThread)
|
||||
import GypsFulvus.PluginStuff
|
||||
import Control.Monad(liftM)
|
||||
data Placeholder = Placeholder
|
||||
data CommandMap = CommandMap (M.Map T.Text Placeholder)
|
||||
data CommandWorkspace = CommandWorkspace Placeholder
|
||||
@ -36,15 +37,16 @@ execMain :: IO ()
|
||||
execMain = do
|
||||
collectorChannel <- atomically newTChan -- normal channel for dumping any user input
|
||||
consumerBroadcastChannel <- atomically newBroadcastTChan
|
||||
loadCommsPlugins collectorChannel
|
||||
availableCommandMap <- atomically $ newTMVar CommandMap
|
||||
loadLabourPlugins availableCommandMap
|
||||
sharedCommandWorkspace <- atomically $ newTMVar CommandWorkspace
|
||||
sharedTaskQueue <- atomically $ newTChan
|
||||
dispatchTID <- forkIO $ dispatchCommands sharedCommandWorkspace sharedTaskQueue
|
||||
broadcastTID <- forkIO $ broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQueue
|
||||
collectorTID <- forkIO $ collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue
|
||||
|
||||
canary <- atomically $ newTMVar False -- simple 'should I exit' canary
|
||||
forkIO $ loadCommsPlugins canary collectorChannel
|
||||
-- availableCommandMap <- atomically $ newTMVar CommandMap
|
||||
-- loadLabourPlugins availableCommandMap
|
||||
-- sharedCommandWorkspace <- atomically $ newTMVar CommandWorkspace
|
||||
-- sharedTaskQueue <- atomically $ newTChan
|
||||
-- dispatchTID <- forkIO $ dispatchCommands sharedCommandWorkspace sharedTaskQueue
|
||||
-- broadcastTID <- forkIO $ broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQueue
|
||||
-- collectorTID <- forkIO $ collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue
|
||||
-- myTIDs = [dispatchTID,broadcastTID,collectorTID]
|
||||
let myTIDs = []
|
||||
runForever canary
|
||||
mapM_ killThread [dispatchTID, broadcastTID, collectorTID]
|
||||
mapM_ killThread myTIDs
|
||||
|
@ -1,7 +1,48 @@
|
||||
module GypsFulvus.PluginStuff(loadCommsPlugins, loadLabourPlugins) where
|
||||
module GypsFulvus.PluginStuff(loadCommsPlugins) where
|
||||
import Control.Monad
|
||||
import System.Directory
|
||||
import System.Plugins.Make
|
||||
import Data.Maybe
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.STM.TMVar
|
||||
|
||||
pluginPath :: IO FilePath
|
||||
pluginPath = getXdgDirectory XdgData "gypsfulvus/plugins" >>= makeAbsolute
|
||||
|
||||
|
||||
configPath :: IO FilePath
|
||||
configPath = getXdgDirectory XdgConfig "gypsfulvus"
|
||||
|
||||
|
||||
|
||||
|
||||
-- load all the plugins for IO (e.g. IRC, stdio, maybe matrix procol, telnet, whatever)
|
||||
loadCommsPlugins collectorChannel = undefined
|
||||
|
||||
|
||||
|
||||
loadCommsPlugins canary collectorChannel =
|
||||
let potentialPlugins = pluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> doesDirectoryExist (pp ++ "/" ++ fuku)) >>= mapM (\fuku -> return (pp ++ "/" ++ fuku))
|
||||
in do
|
||||
pluginPath >>= putStrLn
|
||||
pluginPath >>= listDirectory >>= mapM putStrLn
|
||||
pluginPath >>= \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 -> do
|
||||
putStrLn $ show e
|
||||
|
||||
return ()) 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
|
||||
|
Reference in New Issue
Block a user