update API again.. provide utils
This commit is contained in:
parent
f97c57d773
commit
bf46dd0be3
@ -24,7 +24,8 @@ library
|
||||
containers,
|
||||
text,
|
||||
plugins >= 1.6.0,
|
||||
directory
|
||||
directory,
|
||||
hashable
|
||||
ghc-options:
|
||||
-O2
|
||||
-threaded
|
||||
@ -38,7 +39,8 @@ executable GypsFulvus
|
||||
containers,
|
||||
text,
|
||||
plugins >= 1.6.0,
|
||||
directory
|
||||
directory,
|
||||
hashable
|
||||
ghc-options:
|
||||
-O2
|
||||
-threaded
|
||||
|
@ -1,17 +1,40 @@
|
||||
module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
|
||||
import Control.Concurrent.STM (atomically, retry)
|
||||
module GypsFulvus(execMain, Manhole(..), Sewage(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, regift,stripCommandPrefix',inspectManhole) where
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.STM.TMVar
|
||||
import Control.Concurrent.STM.TChan
|
||||
import qualified Data.Map as M
|
||||
import System.Directory
|
||||
import qualified Data.Text as T
|
||||
import Control.Concurrent(ThreadId, forkIO, killThread)
|
||||
import GypsFulvus.PluginStuff
|
||||
import Control.Monad(liftM)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Hashable
|
||||
data Placeholder = Placeholder
|
||||
data CommandMap = CommandMap (M.Map T.Text Placeholder)
|
||||
data CommandWorkspace = CommandWorkspace Placeholder
|
||||
data Sewer = Sewer (M.Map Int Manhole)
|
||||
|
||||
|
||||
srcPluginPath :: IO FilePath
|
||||
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
|
||||
binPluginPath :: IO FilePath
|
||||
binPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
|
||||
|
||||
|
||||
configPath :: IO FilePath
|
||||
configPath = getXdgDirectory XdgConfig "gypsfulvus"
|
||||
|
||||
|
||||
|
||||
assCallbackWithManholeInSewer
|
||||
:: Hashable a1 =>
|
||||
TMVar (M.Map Int a2 -> M.Map Int a2)
|
||||
-> a1 -> a2 -> STM ()
|
||||
assCallbackWithManholeInSewer sewer callback_name callback_manhole = do
|
||||
sewer_old <- takeTMVar sewer
|
||||
h_cname <- return $ hash callback_name
|
||||
putTMVar sewer $ M.insert h_cname callback_manhole
|
||||
|
||||
dispatchCommands sharedCommandWorkspace sharedTaskQueue = undefined
|
||||
-- broadcast ouputs from routines to all (interested) parties
|
||||
broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQueue = undefined
|
||||
@ -19,6 +42,11 @@ broadcastToConsumers consumerBroadcastChannel sharedCommandWorkspace sharedTaskQ
|
||||
collectInputs collectorChannel availableCommandMap sharedCommandWorkspace sharedTaskQueue = 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
|
||||
|
||||
|
||||
runForever :: TMVar Bool -> IO ()
|
||||
runForever diediedie =
|
||||
let block = do
|
||||
@ -31,14 +59,18 @@ runForever diediedie =
|
||||
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
|
||||
|
||||
|
||||
loadIOBackends sewer = undefined
|
||||
loadCoreCommands = undefined
|
||||
|
||||
execMain :: IO ()
|
||||
execMain = do
|
||||
collectorChannel <- atomically newTChan -- normal channel for dumping any user input
|
||||
consumerBroadcastChannel <- atomically newBroadcastTChan
|
||||
collectorChannel <- atomically newTChan -- normal channel for dumping any user input, this is the output channel for all plugins
|
||||
dumperChannel <- atomically newTChan -- uh this doesnt make any sense, every dings needs to have its own channel
|
||||
|
||||
canary <- atomically $ newTMVar False -- simple 'should I exit' canary
|
||||
forkIO $ loadCommsPlugins canary collectorChannel
|
||||
|
||||
-- forkIO $ loadCommsPlugins canary collectorChannel
|
||||
|
||||
-- availableCommandMap <- atomically $ newTMVar CommandMap
|
||||
-- loadLabourPlugins availableCommandMap
|
||||
-- sharedCommandWorkspace <- atomically $ newTMVar CommandWorkspace
|
||||
@ -50,3 +82,26 @@ execMain = do
|
||||
let myTIDs = []
|
||||
runForever canary
|
||||
mapM_ killThread myTIDs
|
||||
|
||||
|
||||
|
||||
|
||||
--makePluginsForgetThis canary collectorChannel =
|
||||
-- let potentialPlugins = srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> doesDirectoryExist (pp ++ "/" ++ fuku)) >>= mapM (\fuku -> return (pp ++ "/" ++ fuku))
|
||||
-- in do
|
||||
-- srcPluginPath >>= putStrLn
|
||||
-- srcPluginPath >>= listDirectory >>= mapM putStrLn
|
||||
-- srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> putStrLn (pp ++ "/" ++ fuku) >> doesDirectoryExist (pp ++ "/" ++ fuku))
|
||||
-- pp <- potentialPlugins
|
||||
-- mapM_ putStrLn pp
|
||||
-- ff <- mapM (\d -> findFile [d] "Plugin.hs") pp
|
||||
-- let rff = map (fromMaybe "") $ filter (/= Nothing) ff
|
||||
-- s <- mapM (\hng -> makeAll hng ["-v","-dynamic"]) rff
|
||||
-- mapM (\s' -> case s' of
|
||||
-- MakeSuccess _ p -> putStrLn p
|
||||
-- MakeFailure e -> putStrLn $ show e) s
|
||||
-- _ <- atomically $ swapTMVar canary True
|
||||
-- I don't actually want to quit here but I don't like errors from STM heuristics when the canary is GCed
|
||||
|
||||
-- return ()
|
||||
-- end makePluginsForgetThis
|
||||
|
@ -1,11 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module GypsFulvus.PluginStuff(loadCommsPlugins, Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor) where
|
||||
module GypsFulvus.PluginStuff(Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, inspectManhole, regift, stripCommandPrefix') where
|
||||
import Control.Monad
|
||||
import System.Directory
|
||||
|
||||
import System.Plugins.Make
|
||||
import Data.Maybe
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.STM.TMVar
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Text as T
|
||||
|
||||
(♯) :: T.Text -> T.Text -> T.Text
|
||||
@ -13,7 +14,18 @@ a ♯ b = (T.append) a b
|
||||
|
||||
tooTeToSt :: T.Text -> T.Text -> String
|
||||
tooTeToSt a b = tup $ a ♯ "@" ♯ b
|
||||
|
||||
stripCommandPrefix
|
||||
:: T.Text -> [T.Text] -> Either [Maybe T.Text] (Maybe T.Text)
|
||||
stripCommandPrefix c = uniqueHit . filter (/= Nothing) . map (\cs -> T.stripPrefix cs (c ♯ " "))
|
||||
where
|
||||
uniqueHit cs = if (L.length cs == (1 :: Int)) then Right $ head cs else Left cs
|
||||
stripCommandPrefix'
|
||||
:: T.Text -> [T.Text] -> Manhole -> SewageAutorInfo -> IO (Maybe T.Text)
|
||||
stripCommandPrefix' c ccs m sig = case stripCommandPrefix c ccs of
|
||||
Right c -> return c
|
||||
Left cs -> do
|
||||
sew <- regift (Sewage sig (if L.null cs then ("No such command: " ♯ c) else ("Found multiple matching commands: " ♯ ((L.foldr1 (\h ng -> h ♯ ", " ♯ ng)) $ (map (fromMaybe "")) cs)))) m
|
||||
return Nothing
|
||||
tp :: String -> T.Text
|
||||
tp = T.pack
|
||||
tup :: T.Text -> String
|
||||
@ -62,40 +74,7 @@ data Manhole = Manhole {
|
||||
getOutputChan :: TChan Sewage}
|
||||
data InitStatus = GoodInitStatus | BadInitStatus T.Text
|
||||
|
||||
srcPluginPath :: IO FilePath
|
||||
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
|
||||
|
||||
|
||||
configPath :: IO FilePath
|
||||
configPath = getXdgDirectory XdgConfig "gypsfulvus"
|
||||
|
||||
|
||||
|
||||
|
||||
-- load all the plugins for IO (e.g. IRC, stdio, maybe matrix procol, telnet, whatever)
|
||||
|
||||
|
||||
|
||||
loadCommsPlugins canary collectorChannel =
|
||||
let potentialPlugins = srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> doesDirectoryExist (pp ++ "/" ++ fuku)) >>= mapM (\fuku -> return (pp ++ "/" ++ fuku))
|
||||
in do
|
||||
srcPluginPath >>= putStrLn
|
||||
srcPluginPath >>= listDirectory >>= mapM putStrLn
|
||||
srcPluginPath >>= \pp -> listDirectory pp >>= filterM (\fuku -> putStrLn (pp ++ "/" ++ fuku) >> doesDirectoryExist (pp ++ "/" ++ fuku))
|
||||
pp <- potentialPlugins
|
||||
mapM_ putStrLn pp
|
||||
ff <- mapM (\d -> findFile [d] "Plugin.hs") pp
|
||||
let rff = map (fromMaybe "") $ filter (/= Nothing) ff
|
||||
s <- mapM (\hng -> makeAll hng ["-v","-dynamic"]) rff
|
||||
mapM (\s' -> case s' of
|
||||
MakeSuccess _ p -> putStrLn p
|
||||
MakeFailure e -> putStrLn $ show e) s
|
||||
_ <- atomically $ swapTMVar canary True
|
||||
-- I don't actually want to quit here but I don't like errors from STM heuristics when the canary is GCed
|
||||
|
||||
return ()
|
||||
|
||||
|
||||
-- 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
|
||||
inspectManhole :: Manhole -> IO Sewage
|
||||
inspectManhole = atomically . readTChan . getInputChan
|
||||
regift :: Sewage -> Manhole -> IO ()
|
||||
regift g = atomically . (flip writeTChan g) . getOutputChan
|
||||
|
Loading…
x
Reference in New Issue
Block a user