infinity-0.3: API.hs

{-# OPTIONS -fglasgow-exts #-}
module API (
            PLUG,
            Conf,
            InfinityPlugin(..),
            PluginState(..),
            PLUGIN,
            runPlug,
            putState,
            getState,
            updateState,
            send,
            joinchan,
            partchan,
            infinityVer,
            version,
            getplugs,
            retNothing,
            retJust
) where
import qualified Data.Map as M
import Control.Monad.Reader
import Control.Monad.State
import Control.Concurrent
import System.Plugins 
import Data.Version
import Data.Binary
import System.Info
import Text.Printf
import System.Info
import Data.Maybe
import System.IO
import qualified PState as PState
import Logger
import Config

version = unwords ["infinity 0.3;",arch,os,"-",(compilerName++"-"++(showVersion compilerVersion))]

type Conf = [String]

newtype PLUG a = P (StateT Conf (ReaderT PluginState IO) a)
    deriving (Functor,Monad,MonadState Conf,MonadReader PluginState,MonadIO)

type PLUGIN = (String -> String -> String -> Maybe String -> PLUG (Maybe String))

data InfinityPlugin = InfinityPlugin {
  name        :: String,              
  commands    :: [(String,String)],
  action      :: PLUGIN
}

data PluginState = PluginState {
  handle      :: Handle,
  addr        :: String,
  admins      :: [String],
  chans       :: [String],
  pluglist    :: [InfinityPlugin],
  self        :: InfinityPlugin
}

runPlug :: PluginState -> Conf -> PLUG a -> IO (a,Conf)
runPlug s c (P x) = runReaderT (runStateT x c) s

-- api functions for plugins

putState :: Binary a => String -> a -> PLUG ()
putState k v = do
  x <- asks self >>= (return . name)
  y <- io $ PState.putState x k v
  case y of
    Nothing -> return ()
    Just x  -> io $ pluglog Error x

getState :: Binary a => String -> PLUG (Maybe a)
getState k = do
  x <- asks self >>= (return . name)
  y <- io $ PState.getState x k
  case y of
    Left s -> return Nothing
    Right t -> return (Just t)

updateState :: Binary a => String -> a -> PLUG ()
updateState k v = do
  x <- asks self >>= (return . name)
  y <- io $ PState.updateState x k v
  case y of
    Nothing -> return ()
    Just x -> io $ pluglog Error x

getplugs :: PLUG [InfinityPlugin]
getplugs = do
  s <- asks pluglist
  return s

send msg str = do
  h <- asks handle
  n <- asks self >>= (return . name)
  io $ hPrintf h "%s %s\r\n" msg str
  io $ pluglog Normal $ printf "plugin[%s]:\t%s %s" n msg str

privmsg n s = send "PRIVMSG" (n++" :"++s)

joinchan :: String -> PLUG ()
joinchan = send "JOIN"

partchan :: String -> PLUG ()
partchan = send "PART"

retJust :: a -> PLUG (Maybe a)
retJust = return . Just
retNothing :: PLUG (Maybe a)
retNothing = return Nothing

infinityVer :: PLUG String
infinityVer = return version

-- convenience
io :: IO a -> PLUG a
io = liftIO