2014-05-13 00:00:33 +05:30
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
{-# LANGUAGE OverlappingInstances #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-05-04 08:54:12 +05:30
|
|
|
module Main (main) where
|
2014-05-04 02:57:43 +05:30
|
|
|
|
2014-05-10 20:01:25 +05:30
|
|
|
import qualified Data.Configurator as CF
|
2014-05-04 07:43:37 +05:30
|
|
|
|
2014-05-22 01:08:36 +05:30
|
|
|
import ClassyPrelude hiding (getArgs)
|
2014-05-21 11:20:53 +05:30
|
|
|
import Control.Concurrent.Lifted (myThreadId)
|
2014-05-22 01:08:36 +05:30
|
|
|
import Control.Exception.Lifted (throwTo, AsyncException (UserInterrupt))
|
2014-05-21 12:17:00 +05:30
|
|
|
import Data.Configurator.Types (Configured (..), Value (List), ConfigError (..), KeyError (..))
|
2014-05-21 11:20:53 +05:30
|
|
|
import System.Environment (getArgs, getProgName)
|
|
|
|
import System.Exit (exitFailure)
|
2014-05-22 01:08:36 +05:30
|
|
|
import System.Log.Formatter (tfLogFormatter)
|
|
|
|
import System.Log.Handler (setFormatter)
|
|
|
|
import System.Log.Handler.Simple (streamHandler)
|
|
|
|
import System.Log.Logger (Priority (..), updateGlobalLogger, rootLoggerName,
|
|
|
|
setHandlers, setLevel)
|
2014-05-21 11:20:53 +05:30
|
|
|
import System.Posix.Signals (installHandler, sigINT, sigTERM, Handler (Catch))
|
2014-05-04 02:57:43 +05:30
|
|
|
|
2014-05-20 02:40:08 +05:30
|
|
|
import Network.IRC.Types
|
2014-05-04 04:28:44 +05:30
|
|
|
import Network.IRC.Client
|
2014-05-04 02:57:43 +05:30
|
|
|
|
2014-05-04 16:50:19 +05:30
|
|
|
instance Configured a => Configured [a] where
|
|
|
|
convert (List xs) = Just . mapMaybe convert $ xs
|
|
|
|
convert _ = Nothing
|
|
|
|
|
2014-05-04 04:28:44 +05:30
|
|
|
main :: IO ()
|
2014-05-04 02:57:43 +05:30
|
|
|
main = do
|
2014-05-22 01:08:36 +05:30
|
|
|
-- get args
|
2014-05-04 02:57:43 +05:30
|
|
|
args <- getArgs
|
|
|
|
prog <- getProgName
|
2014-05-04 04:28:44 +05:30
|
|
|
|
2014-05-06 02:50:40 +05:30
|
|
|
when (length args < 1) $ do
|
2014-05-10 21:45:16 +05:30
|
|
|
putStrLn $ "Usage: " ++ pack prog ++ " <config file path>"
|
2014-05-06 02:50:40 +05:30
|
|
|
exitFailure
|
|
|
|
|
2014-05-22 01:08:36 +05:30
|
|
|
-- setup signal handling
|
2014-05-11 19:08:43 +05:30
|
|
|
mainThreadId <- myThreadId
|
2014-05-20 02:40:08 +05:30
|
|
|
installHandler sigINT (Catch $ throwTo mainThreadId UserInterrupt) Nothing
|
2014-05-11 19:08:43 +05:30
|
|
|
installHandler sigTERM (Catch $ throwTo mainThreadId UserInterrupt) Nothing
|
|
|
|
|
2014-05-22 01:08:36 +05:30
|
|
|
-- setup logging
|
|
|
|
stderrHandler <- streamHandler stderr DEBUG >>= \lh -> return $
|
|
|
|
setFormatter lh $ tfLogFormatter "%F %T" "[$utcTime] $loggername $prio $msg"
|
|
|
|
updateGlobalLogger rootLoggerName (setHandlers [stderrHandler] . setLevel DEBUG)
|
|
|
|
|
|
|
|
-- load config and start the bot
|
2014-05-10 21:45:16 +05:30
|
|
|
let configFile = headEx args
|
2014-05-21 12:17:00 +05:30
|
|
|
loadBotConfig configFile >>= runBot
|
2014-05-06 02:50:40 +05:30
|
|
|
|
2014-05-10 20:01:25 +05:30
|
|
|
loadBotConfig :: String -> IO BotConfig
|
2014-05-06 02:50:40 +05:30
|
|
|
loadBotConfig configFile = do
|
2014-05-21 11:20:53 +05:30
|
|
|
eCfg <- try $ CF.load [CF.Required configFile]
|
2014-05-06 02:50:40 +05:30
|
|
|
case eCfg of
|
|
|
|
Left (ParseError _ _) -> error "Error while loading config"
|
|
|
|
Right cfg -> do
|
2014-05-20 02:40:08 +05:30
|
|
|
eBotConfig <- try $ BotConfig <$>
|
|
|
|
CF.require cfg "server" <*>
|
|
|
|
CF.require cfg "port" <*>
|
|
|
|
CF.require cfg "channel" <*>
|
|
|
|
CF.require cfg "nick" <*>
|
|
|
|
CF.require cfg "timeout" <*>
|
|
|
|
CF.require cfg "msghandlers" <*>
|
|
|
|
pure cfg
|
2014-05-06 02:50:40 +05:30
|
|
|
|
|
|
|
case eBotConfig of
|
2014-05-10 21:45:16 +05:30
|
|
|
Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k
|
2014-05-20 02:40:08 +05:30
|
|
|
Right botConf -> return botConf
|