add pipe for plugins

This commit is contained in:
Jon Doe 2020-09-14 15:46:45 +02:00 committed by Maciej Bonin
parent aea2f79138
commit b939d9665d
2 changed files with 12 additions and 7 deletions

View File

@ -1,4 +1,4 @@
module GypsFulvus(execMain) where
module GypsFulvus(execMain, Manhole, Sewage) where
import Control.Concurrent.STM (atomically, retry)
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM.TChan

View File

@ -1,13 +1,21 @@
module GypsFulvus.PluginStuff(loadCommsPlugins) where
module GypsFulvus.PluginStuff(loadCommsPlugins, Sewage, Manhole) 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.Text as T
data Sewage = Sewage {
getSewageAuthor :: T.Text,
getSewage :: T.Text
}
data Manhole = Manhole {
getInputChan :: TChan Sewage,
getOutputChan :: TChan Sewage}
srcPluginPath :: IO FilePath
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/src_plugins" >>= makeAbsolute
srcPluginPath = getXdgDirectory XdgData "gypsfulvus/srcplugins" >>= makeAbsolute
configPath :: IO FilePath
@ -33,10 +41,7 @@ loadCommsPlugins canary collectorChannel =
s <- mapM (\hng -> makeAll hng ["-v","-dynamic"]) rff
mapM (\s' -> case s' of
MakeSuccess _ p -> putStrLn p
MakeFailure e -> do
putStrLn $ show e
return ()) s
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