
Alexander Foremny wrote:
I am writing an single server, multi channel IRC bot with the support of plugins and limited plugin communication. With the plugin system I am facing problems I cannot really solve myself.
Here's an approach built completely around Data.Typeable. The fundamental idea is that a Plugin encompasses a set of interfaces of unknown types, which have Typeable instances. All we need is an operation to extract such an interface from a Plugin. data Plugin = Plugin { getInterface :: forall i. Typeable i => Maybe i } Then we can define the interfaces we want to use, for example: data BaseInterface = BaseInterface { identifier :: String, rawMessage :: (MonadIO m) => Message -> PL m () } deriving Typeable Sending a message to a plugin can be implemented as sendMessage :: Plugin -> Message -> PL m () sendMessage p msg = do let pI :: Maybe BaseInterface pI = getInterface p case pI of Nothing -> error "Plugin does not support BaseInterface" Just pI' -> rawMessage pI' msg A more complete example follows below. Does that help? Bertram ------------------------------------------------------------------------ {-# LANGUAGE GADTs, Rank2Types, DeriveDataTypeable #-} module PluginTest (main) where import Data.Typeable import Data.IORef import Control.Monad.Trans import Control.Monad.State import qualified Data.Map as M ------------------------------------------------------------------------ -- Types -- A Plugin is just a method that returns various interfaces. data Plugin = Plugin { getInterface :: forall i. Typeable i => Maybe i } -- The basic interface. -- -- It should be made a part of Plugin, but it's a queryable interface -- in this example for demonstration purposes. data BaseInterface = BaseInterface { identifier :: String, rawMessage :: (MonadIO m) => Message -> PL m () } deriving Typeable type Message = String type PL = StateT PluginConfig type PluginConfig = M.Map String Plugin ------------------------------------------------------------------------ -- Main -- look up a plugin by name findPlugin :: Monad m => String -> PL m (Maybe Plugin) findPlugin k = get >>= return . M.lookup k -- register a plugin registerPlugin :: MonadIO m => Plugin -> PL m () registerPlugin p = do -- note: 'getInterface' can return 'Nothing' - needs error checking let Just i = getInterface p modify (M.insert (identifier i) p) -- unregister, etc. main' :: MonadIO m => PL m () main' = do -- create two plugins (see below) and register them. a <- createAPlugin registerPlugin a b <- createBPlugin registerPlugin b -- extract base interfaces of a and b and send some messages -- (needs error checking) let aI, bI :: BaseInterface Just aI = getInterface a Just bI = getInterface b liftIO $ putStrLn "-> Sending message to A" rawMessage aI "dummy" liftIO $ putStrLn "-> Sending message to B" rawMessage bI "Hi, here's a message from B" liftIO $ putStrLn "-> Sending another message to A" rawMessage aI "dummy" main :: IO () main = evalStateT main' M.empty ------------------------------------------------------------------------ -- Plugin A -- -- This plugin provides an additional Interface that allows to -- query and change a string value in its state. data APlugin = APlugin (IORef String) data AInterface = AInterface { aGet :: (MonadIO m) => PL m String, aPut :: (MonadIO m) => String -> PL m () } deriving Typeable createAPlugin :: (MonadIO m) => PL m Plugin createAPlugin = do r <- liftIO (newIORef "initial state") let a = APlugin r return $ Plugin { getInterface = cast (aBase a) `mplus` cast (aInterface a) } aBase (APlugin r) = BaseInterface { identifier = "A", rawMessage = msg } where msg _ = liftIO $ do s <- readIORef r putStrLn ("A has state (" ++ s ++ ")!") aInterface :: APlugin -> AInterface aInterface (APlugin r) = AInterface { aGet = liftIO (readIORef r), aPut = \v -> liftIO (writeIORef r v) } ------------------------------------------------------------------------ -- Plugin B -- -- Plugin B knows about Plugin A and uses its additional interface for -- modifying its state createBPlugin :: (MonadIO m) => PL m Plugin createBPlugin = return $ Plugin { getInterface = cast bBase } bBase = BaseInterface { identifier = "B", rawMessage = msg } where msg s = do -- find "A" plugin Just a <- findPlugin "A" -- and get its additional interface let aI :: AInterface Just aI = getInterface a aPut aI s