wrath/shaniqua-core
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update API again.. provide utils

Browse Source
This commit is contained in:
Jon Doe 2020-09-20 20:41:30 +02:00 committed by Maciej Bonin
parent f97c57d773
commit bf46dd0be3
3 changed files with 85 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
GypsFulvus.cabal
View File

@ -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

69
src/GypsFulvus.hs
View File

@ -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

59
src/GypsFulvus/PluginStuff.hs
View File

@ -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