infinity-0.3: Monitor.hs

module Monitor (
  MState(..),
  RebootT,
  Monitor,

  runMonitor,
  restart,
  unloadplugs,
  setrebootvar,
  threadQuit,
  cGetLine,
  cGetLines,
  cprint,
  mlog,
  serverNum,
  exit
) where
import Control.Concurrent.STM
import Control.Monad.State
import System.Plugins
import Control.Concurrent
import System.Exit
import System.IO
import Data.Map
import qualified Config as C
import Logger
import API
import Net

data MState = MState {
  rebootvar :: TMVar Int,
  rchan     :: Chan ReportChan,
  servers   :: Map String (Handle,C.Server),
  conf      :: C.Config,
  lFile     :: FilePath,
  reboot    :: RebootT,
  imodule   :: Module,
  pmodules  :: [Module]
}
type RebootT = (Module -> MState -> IO ())
type Monitor a = StateT MState IO a

-- monitor api
runMonitor :: Monitor a -> MState -> IO a
runMonitor = evalStateT

restart :: Monitor ()
restart = do
  m  <- gets imodule
  r  <- gets reboot
  st <- get
  io $ r m st

unloadplugs = do
  p <- gets pmodules
  io $ mapM_ unload p  

threadQuit s = do
  st <- get
  p  <- gets servers
  let new = delete s p
  put $ st{servers=new}

exit = do
  io $ putStrLn "all servers closed, infinity exiting..."
  io $ (exitWith ExitSuccess)

setrebootvar :: Monitor ()
setrebootvar = do
  s <- gets rebootvar
  io (atomically $ putTMVar s 1) 

cGetLines :: Monitor [ReportChan]
cGetLines = do
  r <- gets rchan
  c <- io $ getChanContents r
  return c

cGetLine :: Monitor ReportChan
cGetLine = cGetLines >>= return . head

cprint = io . putStrLn

mlog :: PrintStatus -> String -> Monitor ()
mlog p s = do
  f <- gets lFile
  io $ logger f p (concat ["Monitor: ",s])

serverNum :: Monitor Int
serverNum = gets servers >>= return . size

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