Some refactoring and reformatting
parent
8659c5f755
commit
a3e4b145ec
20
Main.hs
20
Main.hs
|
@ -14,7 +14,7 @@ import System.Environment
|
|||
import System.Exit
|
||||
import System.Posix.Signals
|
||||
|
||||
import Network.IRC.Types (BotConfig(BotConfig))
|
||||
import Network.IRC.Types
|
||||
import Network.IRC.Client
|
||||
|
||||
instance Configured a => Configured [a] where
|
||||
|
@ -43,15 +43,15 @@ loadBotConfig configFile = do
|
|||
case eCfg of
|
||||
Left (ParseError _ _) -> error "Error while loading config"
|
||||
Right cfg -> do
|
||||
eBotConfig <- try $ do
|
||||
server <- CF.require cfg "server"
|
||||
port <- CF.require cfg "port"
|
||||
channel <- CF.require cfg "channel"
|
||||
botNick <- CF.require cfg "nick"
|
||||
timeout <- CF.require cfg "timeout"
|
||||
msghandlers <- CF.require cfg "msghandlers"
|
||||
return $ BotConfig server port channel botNick timeout msghandlers cfg
|
||||
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
|
||||
|
||||
case eBotConfig of
|
||||
Left (KeyError k) -> error $ "Error while reading key from config: " ++ unpack k
|
||||
Right botConfig -> return botConfig
|
||||
Right botConf -> return botConf
|
||||
|
|
|
@ -46,7 +46,10 @@ sendCommandLoop :: EChannel Command -> Bot -> IO ()
|
|||
sendCommandLoop (commandChan, latch) bot@Bot { .. } = do
|
||||
cmd <- readChan commandChan
|
||||
time <- getCurrentTime
|
||||
let line = lineFromCommand botConfig cmd
|
||||
let mline = lineFromCommand botConfig cmd
|
||||
case mline of
|
||||
Nothing -> return ()
|
||||
Just line -> do
|
||||
TF.hprint socket "{}\r\n" $ TF.Only line
|
||||
TF.print "[{}] > {}\n" $ TF.buildParams (formatTime defaultTimeLocale "%F %T" time, line)
|
||||
case cmd of
|
||||
|
@ -128,9 +131,8 @@ listenerLoop lineChan commandChan !idleFor = do
|
|||
mCmd <- runMsgHandler msgHandler botConfig message
|
||||
case mCmd of
|
||||
Nothing -> return ()
|
||||
Just cmd -> case cmd of
|
||||
MessageCmd msg -> sendMessage lineChan msg
|
||||
_ -> sendCommand commandChan cmd
|
||||
Just (MessageCmd msg) -> sendMessage lineChan msg
|
||||
Just cmd -> sendCommand commandChan cmd
|
||||
|
||||
loadMsgHandlers :: BotConfig -> IO (Map MsgHandlerName MsgHandler)
|
||||
loadMsgHandlers botConfig@BotConfig { .. } =
|
||||
|
|
|
@ -54,12 +54,11 @@ exitMessageLogger state = liftIO $ do
|
|||
mHandle <- readIORef state
|
||||
case mHandle of
|
||||
Nothing -> return ()
|
||||
Just (logFileHandle, _ :: Day) -> hClose logFileHandle
|
||||
Just (logFileHandle, _) -> hClose logFileHandle
|
||||
|
||||
withLogFile :: MonadMsgHandler m => (Handle -> IO ()) -> IORef LoggerState -> m (Maybe Command)
|
||||
withLogFile action state = do
|
||||
botConfig <- ask
|
||||
|
||||
liftIO $ do
|
||||
Just (logFileHandle, prevDay) <- readIORef state
|
||||
curDay <- map utctDay getCurrentTime
|
||||
|
@ -80,18 +79,17 @@ withLogFile action state = do
|
|||
return Nothing
|
||||
|
||||
messageLogger :: MonadMsgHandler m => Message -> IORef LoggerState -> m (Maybe Command)
|
||||
messageLogger message = go message
|
||||
messageLogger message = case message of
|
||||
ChannelMsg { .. } -> log "<{}> {}" [userNick user, msg]
|
||||
ActionMsg { .. } -> log "<{}> {} {}" [userNick user, userNick user, msg]
|
||||
KickMsg { .. } -> log "** {} KICKED {} :{}" [userNick user, kickedNick, msg]
|
||||
JoinMsg { .. } -> log "** {} JOINED" [userNick user]
|
||||
PartMsg { .. } -> log "** {} PARTED :{}" [userNick user, msg]
|
||||
QuitMsg { .. } -> log "** {} QUIT :{}" [userNick user, msg]
|
||||
NickMsg { .. } -> log "** {} CHANGED NICK TO {}" [userNick user, nick]
|
||||
NamesMsg { .. } -> log "** USERS {}" [unwords nicks]
|
||||
_ -> const $ return Nothing
|
||||
where
|
||||
go ChannelMsg { .. } = log "<{}> {}" [userNick user, msg]
|
||||
go ActionMsg { .. } = log "<{}> {} {}" [userNick user, userNick user, msg]
|
||||
go KickMsg { .. } = log "** {} KICKED {} :{}" [userNick user, kickedNick, msg]
|
||||
go JoinMsg { .. } = log "** {} JOINED" [userNick user]
|
||||
go PartMsg { .. } = log "** {} PARTED :{}" [userNick user, msg]
|
||||
go QuitMsg { .. } = log "** {} QUIT :{}" [userNick user, msg]
|
||||
go NickMsg { .. } = log "** {} CHANGED NICK TO {}" [userNick user, nick]
|
||||
go NamesMsg { .. } = log "** USERS {}" [unwords nicks]
|
||||
go _ = const $ return Nothing
|
||||
|
||||
log format args = withLogFile $ \logFile ->
|
||||
TF.hprint logFile ("[{}] " ++ format ++ "\n") $ TF.buildParams (fmtTime (msgTime message) : args)
|
||||
|
||||
|
|
|
@ -32,8 +32,8 @@ instance FromJSON Song where
|
|||
parseJSON _ = mempty
|
||||
|
||||
songSearch :: MonadMsgHandler m => Message -> m (Maybe Command)
|
||||
songSearch ChannelMsg { .. } = if "!m " `isPrefixOf` msg
|
||||
then do
|
||||
songSearch ChannelMsg { .. }
|
||||
| "!m " `isPrefixOf` msg = do
|
||||
BotConfig { .. } <- ask
|
||||
liftIO $ do
|
||||
let query = strip . drop 3 $ msg
|
||||
|
@ -51,5 +51,5 @@ songSearch ChannelMsg { .. } = if "!m " `isPrefixOf` msg
|
|||
Right song -> case song of
|
||||
Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url
|
||||
NoSong -> "No song found for: " ++ query
|
||||
else return Nothing
|
||||
| otherwise = return Nothing
|
||||
songSearch _ = return Nothing
|
||||
|
|
|
@ -23,13 +23,11 @@ msgFromLine (BotConfig { .. }) time line
|
|||
then ModeMsg time Self target message [] line
|
||||
else ModeMsg time user target mode modeArgs line
|
||||
"NICK" -> NickMsg time user (drop 1 target) line
|
||||
"PRIVMSG" -> if target == channel
|
||||
then if "\x01" `isPrefixOf` message && "ACTION" `isPrefixOf` drop 1 message
|
||||
then ActionMsg time user (initDef . drop 8 $ message) line
|
||||
else ChannelMsg time user message line
|
||||
else PrivMsg time user message line
|
||||
"353" -> NamesMsg time namesNicks
|
||||
"433" -> NickInUseMsg time line
|
||||
"PRIVMSG" | target /= channel -> PrivMsg time user message line
|
||||
| isActionMsg -> ActionMsg time user (initDef . drop 8 $ message) line
|
||||
| otherwise -> ChannelMsg time user message line
|
||||
_ -> OtherMsg time source command target message line
|
||||
where
|
||||
isSpc = (== ' ')
|
||||
|
@ -51,15 +49,17 @@ msgFromLine (BotConfig { .. }) time line
|
|||
namesNicks = map stripNickPrefix . words . drop 1 . unwords . drop 5 $ splits
|
||||
stripNickPrefix = pack . dropWhile (`elem` nickPrefixes) . unpack
|
||||
|
||||
lineFromCommand :: BotConfig -> Command -> Text
|
||||
lineFromCommand (BotConfig { .. }) command = case command of
|
||||
PongCmd { .. } -> "PONG :" ++ rmsg
|
||||
PingCmd { .. } -> "PING :" ++ rmsg
|
||||
NickCmd -> "NICK " ++ botNick
|
||||
UserCmd -> "USER " ++ botNick ++ " 0 * :" ++ botNick
|
||||
JoinCmd -> "JOIN " ++ channel
|
||||
QuitCmd -> "QUIT"
|
||||
ChannelMsgReply { .. } -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
|
||||
PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg
|
||||
NamesCmd -> "NAMES " ++ channel
|
||||
_ -> error $ "Unsupported command " ++ show command
|
||||
isActionMsg = "\SOH" `isPrefixOf` message && "ACTION" `isPrefixOf` drop 1 message
|
||||
|
||||
lineFromCommand :: BotConfig -> Command -> Maybe Text
|
||||
lineFromCommand BotConfig { .. } command = case command of
|
||||
PongCmd { .. } -> Just $ "PONG :" ++ rmsg
|
||||
PingCmd { .. } -> Just $ "PING :" ++ rmsg
|
||||
NickCmd -> Just $ "NICK " ++ botNick
|
||||
UserCmd -> Just $ "USER " ++ botNick ++ " 0 * :" ++ botNick
|
||||
JoinCmd -> Just $ "JOIN " ++ channel
|
||||
QuitCmd -> Just "QUIT"
|
||||
ChannelMsgReply { .. } -> Just $ "PRIVMSG " ++ channel ++ " :" ++ rmsg
|
||||
PrivMsgReply (User { .. }) rmsg -> Just $ "PRIVMSG " ++ botNick ++ " :" ++ rmsg
|
||||
NamesCmd -> Just $ "NAMES " ++ channel
|
||||
_ -> Nothing
|
||||
|
|
|
@ -8,9 +8,22 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Types
|
||||
(Channel, Nick, MsgHandlerName, User (..), Message (..), Command (..),
|
||||
BotConfig (..), BotStatus (..), Bot (..), IRC, runIRC,
|
||||
MsgHandler (..), MonadMsgHandler, newMsgHandler, runMsgHandler, stopMsgHandler)
|
||||
( Channel
|
||||
, Nick
|
||||
, MsgHandlerName
|
||||
, User (..)
|
||||
, Message (..)
|
||||
, Command (..)
|
||||
, BotConfig (..)
|
||||
, BotStatus (..)
|
||||
, Bot (..)
|
||||
, IRC
|
||||
, runIRC
|
||||
, MsgHandler (..)
|
||||
, MonadMsgHandler
|
||||
, newMsgHandler
|
||||
, runMsgHandler
|
||||
, stopMsgHandler)
|
||||
where
|
||||
|
||||
import ClassyPrelude
|
||||
|
|
|
@ -49,6 +49,8 @@ build-type: Simple
|
|||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
other-extensions: Safe
|
||||
|
||||
build-depends: base >=4.5 && <4.8,
|
||||
text >=0.11 && <0.12,
|
||||
mtl >=2.1 && <2.2,
|
||||
|
@ -83,7 +85,7 @@ executable hask-irc
|
|||
-- other-modules:
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
other-extensions: RecordWildCards, OverloadedStrings, ScopedTypeVariables, OverlappingInstances
|
||||
other-extensions: Safe
|
||||
|
||||
-- Other library packages from which modules are imported.
|
||||
build-depends: base >=4.5 && <4.8,
|
||||
|
|
Loading…
Reference in New Issue