unbreak namespaces
This commit is contained in:
parent
35e395960c
commit
c9bdb637ce
@ -13,11 +13,13 @@ 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
|
||||||
@ -25,3 +27,18 @@ executable GypsFulvus
|
|||||||
-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
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 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]
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user