[Haskell-cafe] Writing an IRC bot, problems with plugins

[Bertram Felgenhauer]

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