shaniqua-core/src/GypsFulvus.hs

53 lines
2.3 KiB
Haskell
Raw Normal View History

2020-09-18 22:22:43 +02:00
module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
2020-09-12 21:44:21 +02:00
import Control.Concurrent.STM (atomically, retry)
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TChan
import qualified Data.Map as M
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-12 21:44:21 +02:00
data Placeholder = Placeholder
data CommandMap = CommandMap (M.Map T.Text Placeholder)
data CommandWorkspace = CommandWorkspace Placeholder
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
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
execMain :: IO ()
execMain = do
collectorChannel <- atomically newTChan -- normal channel for dumping any user input
consumerBroadcastChannel <- atomically newBroadcastTChan
canary <- atomically $ newTMVar False -- simple 'should I exit' canary
2020-09-12 23:56:49 +02:00
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 = []
2020-09-12 21:44:21 +02:00
runForever canary
2020-09-12 23:56:49 +02:00
mapM_ killThread myTIDs