unbreak namespaces

This commit is contained in:
Jon Doe 2020-09-12 21:44:21 +02:00 committed by Maciej Bonin
parent 35e395960c
commit c9bdb637ce
4 changed files with 82 additions and 59 deletions

View File

@ -13,15 +13,32 @@ build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
extra-source-files: README.md extra-source-files: README.md
executable GypsFulvus library
hs-source-dirs: src exposed-modules: GypsFulvus
main-is: Main.hs other-modules: GypsFulvus.PluginStuff
default-language: Haskell2010 default-language: Haskell2010
build-depends: base >= 4.7 && < 5, hs-source-dirs: src
build-depends:
base >= 4.7 && < 5,
stm, stm,
containers, containers,
text text
ghc-options: ghc-options:
-O2 -O2
-threaded -threaded
-with-rtsopts=-N -with-rtsopts=-N
executable GypsFulvus
default-language: Haskell2010
build-depends:
base >= 4.7 && < 5,
stm,
containers,
text
ghc-options:
-O2
-threaded
-with-rtsopts=-N
hs-source-dirs: src
other-modules: GypsFulvus, GypsFulvus.PluginStuff
main-is: Main.hs

50
src/GypsFulvus.hs Normal file
View File

@ -0,0 +1,50 @@
module GypsFulvus(execMain) where
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
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
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
runForever canary
mapM_ killThread [dispatchTID, broadcastTID, collectorTID]

View File

@ -0,0 +1,7 @@
module GypsFulvus.PluginStuff(loadCommsPlugins, loadLabourPlugins) where
-- load all the plugins for IO (e.g. IRC, stdio, maybe matrix procol, telnet, whatever)
loadCommsPlugins collectorChannel = 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

View File

@ -1,53 +1,2 @@
module Main where import GypsFulvus(execMain)
import Control.Concurrent.STM (atomically, retry) main = execMain
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)
data Placeholder = Placeholder
data CommandMap = CommandMap (M.Map T.Text Placeholder)
data CommandWorkspace = CommandWorkspace Placeholder
-- load all the plugins for IO (e.g. IRC, stdio, maybe matrix procol, telnet, whatever)
loadCommsPlugins collectorChannel = 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
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
main :: IO ()
main = 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
runForever canary
mapM_ killThread [dispatchTID, broadcastTID, collectorTID]