lambdabot-4.0: Main.hs

--
-- | Let's go lambdabot!
--
module Main where

import Shared
import Lambdabot
import Config
import Modules
import Message

import qualified Data.Map as M

import System.Environment

import Data.Maybe
import Control.Monad.State (get, liftIO, modify)

------------------------------------------------------------------------

-- do argument handling
main :: IO ()
main = main' Nothing

dynmain :: DynLoad  -> IO ()
dynmain fn = main' (Just fn)

main' :: Maybe DynLoad -> IO ()
main' dyn = do
    x    <- getArgs
    case x of
        ["--online"] -> runIrc Online  loadStaticModules onlineMain  load
        []           -> runIrc Offline loadStaticModules offlineMain load
        _            -> putStrLn "Usage: lambdabot [--online]"

    where load = fromMaybe (error "no dynamic loading") dyn

--
-- special online target for ghci use
online :: IO ()
online = runIrc Online loadStaticModules onlineMain $
            fromMaybe (error "no dynamic loading") Nothing

------------------------------------------------------------------------

onlineMain :: LB ()
onlineMain = serverSignOn (protocol config) (name config) (userinfo config) >> mainloop

offlineMain :: LB ()
offlineMain = do 
  modify (\st -> let privUsers  = ircPrivilegedUsers st
                     privUsers' = M.insert "null" True privUsers
                 in st { ircPrivilegedUsers = privUsers' })
  mainloop

------------------------------------------------------------------------

-- it's all asynchronous, remember, the reader and writer threads
-- communicating over chans in the LB state. maybe its too much?
mainloop :: LB ()
mainloop = do
    mmsg <- ircRead
    case mmsg of
        Nothing -> return ()
        Just msg -> do
            s   <- get
            case M.lookup (command msg) (ircCallbacks s) of
                 Just cbs -> allCallbacks (map snd cbs) msg
                 _        -> return ()
    mainloop

-- If an error reaches allCallbacks, then all we can sensibly do is
-- write it on standard out. Hopefully BaseModule will have caught it already
-- if it can see a better place to send it

allCallbacks :: Message a => [a -> LB ()] -> a -> LB ()
allCallbacks [] _ = return ()
allCallbacks (f:fs) msg = do
    handleIrc (liftIO . putStrLn . ("Main: caught (and ignoring) "++). show) (f msg)
    allCallbacks fs msg

------------------------------------------------------------------------