From c9bdb637ce81a7b38ba64825e4d1203d005276f6 Mon Sep 17 00:00:00 2001 From: Jon Doe Date: Sat, 12 Sep 2020 21:44:21 +0200 Subject: [PATCH] unbreak namespaces --- GypsFulvus.cabal | 29 ++++++++++++++---- src/GypsFulvus.hs | 50 +++++++++++++++++++++++++++++++ src/GypsFulvus/PluginStuff.hs | 7 +++++ src/Main.hs | 55 ++--------------------------------- 4 files changed, 82 insertions(+), 59 deletions(-) create mode 100644 src/GypsFulvus.hs create mode 100644 src/GypsFulvus/PluginStuff.hs diff --git a/GypsFulvus.cabal b/GypsFulvus.cabal index 93f14e5..94c421e 100644 --- a/GypsFulvus.cabal +++ b/GypsFulvus.cabal @@ -13,15 +13,32 @@ build-type: Simple cabal-version: >=1.10 extra-source-files: README.md -executable GypsFulvus - hs-source-dirs: src - main-is: Main.hs - default-language: Haskell2010 - build-depends: base >= 4.7 && < 5, +library + exposed-modules: GypsFulvus + other-modules: GypsFulvus.PluginStuff + default-language: Haskell2010 + hs-source-dirs: src + build-depends: + base >= 4.7 && < 5, stm, containers, text - ghc-options: + ghc-options: -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 diff --git a/src/GypsFulvus.hs b/src/GypsFulvus.hs new file mode 100644 index 0000000..73b1bb3 --- /dev/null +++ b/src/GypsFulvus.hs @@ -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] diff --git a/src/GypsFulvus/PluginStuff.hs b/src/GypsFulvus/PluginStuff.hs new file mode 100644 index 0000000..9c9241d --- /dev/null +++ b/src/GypsFulvus/PluginStuff.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index efcac1a..1ebdf85 100644 --- a/src/Main.hs +++ b/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