summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Command.hs4
-rw-r--r--Hsbot/Core.hs8
-rw-r--r--Hsbot/IRC.hs8
-rw-r--r--Hsbot/IRCParser.hs2
-rw-r--r--Hsbot/IRCPlugin.hs33
-rw-r--r--Hsbot/Plugin.hs2
-rw-r--r--Hsbot/Types.hs41
-rw-r--r--Hsbot/Utils.hs2
8 files changed, 49 insertions, 51 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs
index 711aa32..4653618 100644
--- a/Hsbot/Command.hs
+++ b/Hsbot/Command.hs
@@ -42,7 +42,7 @@ dispatchMessage (InputMsg inputMsg)
| isPluginCommand = do
plugins <- gets botPlugins
cmds <- gets botCommands
- let key = tail $ head $ words getMsgContent
+ let key = tail . head $ words getMsgContent
pluginNames = fromMaybe [] $ M.lookup key cmds
plugins' = fromMaybe [] $ mapM (flip M.lookup plugins) pluginNames
mapM_ (sendRunCommand $ tail getMsgContent) plugins'
@@ -56,7 +56,7 @@ dispatchMessage (InputMsg inputMsg)
, (head getMsgContent) == (commandPrefix config) ]
sendRunCommand :: String -> Plugin -> IrcBot ()
sendRunCommand cmd plugin = do
- sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd (Just inputMsg)) plugin
+ sendToPlugin (InternalCmd $ IntCmd "RUN" "CORE" (pluginName plugin) cmd inputMsg) plugin
getMsgContent :: String
getMsgContent = unwords . tail $ parameters inputMsg
dispatchMessage _ = return ()
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 2195525..ab2989a 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -5,7 +5,7 @@ module Hsbot.Core
import Control.Concurrent
import Control.Concurrent.Chan()
-import Control.Exception
+import Control.Exception(IOException, catch)
import Control.Monad.State
import Data.List()
import qualified Data.Map as M
@@ -44,10 +44,10 @@ disconnectServer = do
mapM_ unloadPlugin (M.keys $ botPlugins bot)
liftIO $ putStrLn"done."
liftIO $ putStr "Closing server communication channel... "
- liftIO $ killThread $ readerThreadId bot
+ liftIO . killThread $ readerThreadId bot
liftIO $ putStrLn "done."
- liftIO $ putStr $ "Disconnecting from " ++ name ++ "... "
- liftIO $ hClose $ botHandle bot
+ liftIO . putStr $ "Disconnecting from " ++ name ++ "... "
+ liftIO . hClose $ botHandle bot
liftIO $ putStrLn "done."
-- | Socket reading loop
diff --git a/Hsbot/IRC.hs b/Hsbot/IRC.hs
index 1eac2d8..4a0e5f8 100644
--- a/Hsbot/IRC.hs
+++ b/Hsbot/IRC.hs
@@ -15,10 +15,10 @@ import Hsbot.Utils
initServer :: IrcBot ()
initServer = do
server <- gets serverConfig
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "NICK" [(nickname server)]
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "NICK" [(nickname server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "USER" [(nickname server), "0", "*", (realname server)]
when (not . null $ password server) $ do
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "PRIVMSG" ["nickserv", "identify", (password server)]
mapM_ joinChan (joinChannels server)
-- | Run a server
@@ -40,6 +40,6 @@ joinChan name = do
newChannel = Channel name
(nickname $ serverConfig bot)
(administrators $ serverConfig bot)
- sendstr $ serializeIrcMsg $ IrcMsg Nothing "JOIN" [name]
+ sendstr . serializeIrcMsg $ IrcMsg Nothing "JOIN" [name]
put $ bot { chans = newChannel : oldChannels }
diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs
index 263ac1f..d284377 100644
--- a/Hsbot/IRCParser.hs
+++ b/Hsbot/IRCParser.hs
@@ -18,7 +18,7 @@ pMsg = do
pfx <- optionMaybe pPrefix
cmd <- pCommand
params <- many (char ' ' >> (pLongParam <|> pShortParam))
- char '\r'
+ _ <- char '\r'
--eof
return $ IrcMsg pfx cmd params
diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs
index 4707ce1..e0299fc 100644
--- a/Hsbot/IRCPlugin.hs
+++ b/Hsbot/IRCPlugin.hs
@@ -1,5 +1,7 @@
module Hsbot.IRCPlugin
- ( answerMsg
+ ( IrcPlugin
+ , PluginState(..)
+ , answerMsg
, readMsg
, sendCommand
, sendCommandWithRequest
@@ -14,6 +16,16 @@ import Data.Maybe(fromMaybe)
import Hsbot.Types
+-- | The IrcPlugin monad
+type IrcPlugin a = StateT PluginState IO a
+
+-- | An IRCPlugin state
+data PluginState = PluginState
+ { instanceName :: String -- The plugin's name
+ , instanceServerChan :: Chan BotMsg -- The server channel
+ , instanceChan :: Chan BotMsg -- The plugin channel
+ }
+
-- | Basic input output for IrcPlugins
readMsg :: IrcPlugin (BotMsg)
readMsg = do
@@ -24,26 +36,25 @@ readMsg = do
writeMsg :: BotMsg -> IrcPlugin ()
writeMsg botMsg = do
serverChan <- gets instanceServerChan
- liftIO $ writeChan serverChan $ botMsg
+ liftIO . writeChan serverChan $ botMsg
-answerMsg :: Maybe IrcMsg -> String -> IrcPlugin ()
+answerMsg :: IrcMsg -> String -> IrcPlugin ()
answerMsg request msg = do
- let incoming = fromMaybe (IrcMsg Nothing "ARGH" []) request
- chanOrigin = head $ parameters (incoming)
- sender = takeWhile (/= '!') $ fromMaybe "ARGH" (prefix incoming)
+ let chanOrigin = head $ parameters request
+ sender = takeWhile (/= '!') $ fromMaybe "" (prefix request)
case head chanOrigin of
- '#' -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
- _ -> writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
+ '#' -> writeMsg . OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, msg]
+ _ -> writeMsg . OutputMsg $ IrcMsg Nothing "PRIVMSG" [sender, msg]
-- | Commands management
sendCommand :: String -> String -> String -> IrcPlugin ()
-sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing
+sendCommand cmd to params = sendCommandWithRequest cmd to params emptyIrcMsg
-sendCommandWithRequest :: String -> String -> String -> Maybe IrcMsg -> IrcPlugin ()
+sendCommandWithRequest :: String -> String -> String -> IrcMsg -> IrcPlugin ()
sendCommandWithRequest cmd to params originalRequest = do
serverChan <- gets instanceServerChan
from <- gets instanceName
- liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params originalRequest
+ liftIO . writeChan serverChan . InternalCmd $ IntCmd cmd from to params originalRequest
sendRegisterCommand :: String -> IrcPlugin ()
sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index 43ce0fb..13d0efc 100644
--- a/Hsbot/Plugin.hs
+++ b/Hsbot/Plugin.hs
@@ -33,7 +33,7 @@ effectivelyLoadPlugin name entryPoint serverChan = do
return $ Plugin name threadId chan
-- | Sends a list of loaded plugins
-listPlugins :: Maybe IrcMsg -> String -> IrcBot ()
+listPlugins :: IrcMsg -> String -> IrcBot ()
listPlugins originalRequest dest = do
plugins <- gets botPlugins
let listing = unwords $ M.keys plugins
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 436bbdf..aa45f8b 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -7,9 +7,8 @@ module Hsbot.Types
, IrcServer(..)
, IrcBot
, IrcMsg(..)
- , IrcPlugin
, Plugin(..)
- , PluginInstance(..)
+ , emptyIrcMsg
) where
import Control.Concurrent
@@ -47,11 +46,6 @@ instance Show IrcServer where
UnixSocket u -> show u)
++ (show c) ++ (show n) ++ (show pa) ++ (show r) ++ (show ad)
--- instance Show PortID where
--- show (PortNumber n) = show n
--- show (Service s) = show s
--- show (UnixSocket g) = show g
-
-- | The IrcBot monad
type IrcBot a = StateT Bot IO a
@@ -68,11 +62,11 @@ data Bot = Bot
}
instance Show Bot where
- show (Bot _ s h c p _ _ cmds) = "Start time : " ++ (show s) ++ "\n"
- ++ "Handle : " ++ (show h) ++ "\n"
- ++ "Channels : " ++ (show c) ++ "\n"
- ++ "Plugins : " ++ (show p) ++ "\n"
- ++ "Commands : " ++ (show cmds) ++ "\n"
+ show (Bot _ s h c p _ _ cmds) = unlines [ "Start time : " ++ (show s)
+ , "Handle : " ++ (show h)
+ , "Channels : " ++ (show c)
+ , "Plugins : " ++ (show p)
+ , "Commands : " ++ (show cmds)]
-- | A channel connection
data Channel = Channel
@@ -88,13 +82,16 @@ data IrcMsg = IrcMsg
, parameters :: [String] -- the message parameters
} deriving (Show)
+emptyIrcMsg :: IrcMsg
+emptyIrcMsg = IrcMsg Nothing "" []
+
-- | An internal command
data IntCmd = IntCmd
- { intCmdCmd :: String -- the internal command
- , intCmdFrom :: String -- who issues it
- , intCmdTo :: String -- who it is destinated to
- , intCmdMsg :: String -- the message to be transfered
- , intCmdBotMsg :: Maybe IrcMsg -- An IrcMsg attached to the command
+ { intCmdCmd :: String -- the internal command
+ , intCmdFrom :: String -- who issues it
+ , intCmdTo :: String -- who it is destinated to
+ , intCmdMsg :: String -- the message to be transfered
+ , intCmdBotMsg :: IrcMsg -- An IrcMsg attached to the command
} deriving (Show)
data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (Show)
@@ -109,13 +106,3 @@ data Plugin = Plugin
instance Show Plugin where
show (Plugin name _ _) = show name
--- | A IrcPlugin ("user" side)
-data PluginInstance = PluginInstance
- { instanceName :: String -- The plugin's name
- , instanceServerChan :: Chan BotMsg -- The server channel
- , instanceChan :: Chan BotMsg -- The plugin channel
- }
-
--- | The IrcPlugin monad
-type IrcPlugin a = StateT PluginInstance IO a
-
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index a58fd0c..247a65c 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -16,7 +16,7 @@ import Hsbot.Types
-- |Wrap a string with ANSI escape sequences.
inColor :: String -> [Int] -> String
inColor str vals = "\ESC[" ++ valstr ++ "m" ++ str ++ "\ESC[0m"
- where valstr = concat $ intersperse ";" $ map show vals
+ where valstr = concat . intersperse ";" $ map show vals
-- | Sends a string over handle
sendstr :: String -> IrcBot ()
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 04:37:04 +0000