Files
shaniqua-core/src/GypsFulvus.hs

108 lines
4.4 KiB
Haskell
Raw Normal View History

2020-09-20 20:41:30 +02:00
module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, regift,stripCommandPrefix',inspectManhole) where
import Control.Concurrent.STM
2020-09-12 21:44:21 +02:00
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TChan
2020-09-20 20:41:30 +02:00
import System.Directory
2020-09-12 21:44:21 +02:00
import qualified Data.Text as T
import Control.Concurrent(ThreadId, forkIO, killThread)
import GypsFulvus.PluginStuff
2020-09-12 23:56:49 +02:00
import Control.Monad(liftM)
2020-09-20 20:41:30 +02:00
import qualified Data.Map.Strict as M
import Data.Hashable
2020-09-12 21:44:21 +02:00
data Placeholder = Placeholder
data CommandMap = CommandMap (M.Map T.Text Placeholder)
data CommandWorkspace = CommandWorkspace Placeholder
2020-09-20 20:41:30 +02:00
data Sewer = Sewer (M.Map Int Manhole)
2020-09-12 21:44:21 +02:00
2020-09-20 20:41:30 +02:00
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
2020-09-12 21:44:21 +02:00
dispatchCommands sharedCommandWorkspace sharedTaskQueue = undefined
-- broadcast ouputs from routines to all (interested) parties
broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQueue = undefined
-- collect all input from all comms plugins and queue for dispatch
collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue = undefined
2020-09-20 20:41:30 +02:00
-- 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
2020-09-12 21:44:21 +02:00
runForever :: TMVar Bool -> IO ()
runForever diediedie =
let block = do
canaryDead <- readTMVar diediedie
if (canaryDead) then
return canaryDead
else
retry
in atomically block >>= \isDone ->
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
2020-09-20 20:41:30 +02:00
loadIOBackends sewer = undefined
loadCoreCommands = undefined
2020-09-12 21:44:21 +02:00
execMain :: IO ()
execMain = do
2020-09-20 20:41:30 +02:00
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
2020-09-12 21:44:21 +02:00
canary <- atomically $ newTMVar False -- simple 'should I exit' canary
2020-09-20 20:41:30 +02:00
-- forkIO $ loadCommsPlugins canary collectorChannel
2020-09-12 23:56:49 +02:00
-- 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 = []
2020-09-12 21:44:21 +02:00
runForever canary
2020-09-12 23:56:49 +02:00
mapM_ killThread myTIDs
2020-09-20 20:41:30 +02:00
--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