unbreak namespaces
This commit is contained in:
parent
35e395960c
commit
c9bdb637ce
@ -13,11 +13,13 @@ build-type: Simple
|
||||
cabal-version: >=1.10
|
||||
extra-source-files: README.md
|
||||
|
||||
executable GypsFulvus
|
||||
hs-source-dirs: src
|
||||
main-is: Main.hs
|
||||
library
|
||||
exposed-modules: GypsFulvus
|
||||
other-modules: GypsFulvus.PluginStuff
|
||||
default-language: Haskell2010
|
||||
build-depends: base >= 4.7 && < 5,
|
||||
hs-source-dirs: src
|
||||
build-depends:
|
||||
base >= 4.7 && < 5,
|
||||
stm,
|
||||
containers,
|
||||
text
|
||||
@ -25,3 +27,18 @@ executable GypsFulvus
|
||||
-O2
|
||||
-threaded
|
||||
-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
50
src/GypsFulvus.hs
Normal 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]
|
7
src/GypsFulvus/PluginStuff.hs
Normal file
7
src/GypsFulvus/PluginStuff.hs
Normal 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
|
55
src/Main.hs
55
src/Main.hs
@ -1,53 +1,2 @@
|
||||
module Main 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)
|
||||
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]
|
||||
import GypsFulvus(execMain)
|
||||
main = execMain
|
||||
|
Loading…
x
Reference in New Issue
Block a user