Added the IRCParser (thx galdor), and PrivMsg handling (simply repeat)
This commit is contained in:
parent
65646eb07f
commit
dfd0b3dcd7
4 changed files with 78 additions and 19 deletions
2
Hsbot.hs
2
Hsbot.hs
|
@ -2,11 +2,13 @@ module Hsbot
|
|||
( module Config
|
||||
, module Hsbot.Core
|
||||
, module Hsbot.IRC
|
||||
, module Hsbot.IRCParser
|
||||
, module Hsbot.Main
|
||||
) where
|
||||
|
||||
import Config
|
||||
import Hsbot.Core
|
||||
import Hsbot.IRC
|
||||
import Hsbot.IRCParser
|
||||
import Hsbot.Main
|
||||
|
||||
|
|
25
Hsbot/IRC.hs
25
Hsbot/IRC.hs
|
@ -5,15 +5,18 @@ module Hsbot.IRC
|
|||
, parseIrcMsg
|
||||
, ping
|
||||
, pong
|
||||
, sendPrivmsg
|
||||
)where
|
||||
|
||||
import Control.Monad
|
||||
import Data.List(isPrefixOf)
|
||||
import Data.Maybe
|
||||
import Network
|
||||
import qualified Network.IRC as IRC
|
||||
import System.IO
|
||||
|
||||
import Hsbot.Core
|
||||
import Hsbot.IRCParser
|
||||
|
||||
type User = String
|
||||
type Channel = String
|
||||
|
@ -21,7 +24,7 @@ type Command = String
|
|||
type Args = [String]
|
||||
|
||||
-- | An IRC line
|
||||
data IrcLine = Str String -- a regular string
|
||||
data IrcLine = Privmsg (String, [String]) -- statement (chan, sentence...)
|
||||
| Quit (IrcServer, Handle) -- a quit message from a server
|
||||
| Join (IrcServer, Channel) -- joined a channel
|
||||
| Part (IrcServer, Channel) -- parted the channel
|
||||
|
@ -31,8 +34,21 @@ data IrcLine = Str String -- a regular string
|
|||
deriving (Eq,Show)
|
||||
|
||||
-- | Parses an IrcInput
|
||||
parseIrcMsg :: String -> IrcInput
|
||||
parseIrcMsg str = (Cmd "user" "channel" (str, Just "args"))
|
||||
parseIrcMsg :: String -> IrcLine
|
||||
parseIrcMsg str =
|
||||
case (ircParser str) of
|
||||
Left err -> Nil
|
||||
Right x -> eval x
|
||||
where
|
||||
eval :: IrcMsg -> IrcLine
|
||||
eval x@(IrcMsg statement cmd stuff)
|
||||
| cmd == "PING" = Ping $ head stuff
|
||||
| cmd == "PRIVMSG" =
|
||||
case statement of
|
||||
Nothing -> Nil
|
||||
Just statement' -> if stuff!!1 == "reboot" then Reboot
|
||||
else Privmsg $ (statement', stuff)
|
||||
| otherwise = Nil
|
||||
|
||||
-- | Connects to a server
|
||||
connectServer :: IrcServer -> IO (IrcServer, Handle)
|
||||
|
@ -61,3 +77,6 @@ ping = isPrefixOf "PING :"
|
|||
pong :: Handle -> String -> IO ()
|
||||
pong handle str = sendstr handle $ "PONG " ++ (drop 5 str)
|
||||
|
||||
sendPrivmsg :: (IrcServer, Handle) -> [String] -> IO ()
|
||||
sendPrivmsg (server, handle) stuff' = sendstr handle (IRC.encode $ IRC.privmsg (head stuff') (unwords . tail $ stuff'))
|
||||
|
||||
|
|
36
Hsbot/IRCParser.hs
Normal file
36
Hsbot/IRCParser.hs
Normal file
|
@ -0,0 +1,36 @@
|
|||
module Hsbot.IRCParser
|
||||
( IrcMsg (..)
|
||||
, ircParser
|
||||
) where
|
||||
|
||||
--import Text.Parsec
|
||||
import Text.ParserCombinators.Parsec
|
||||
|
||||
-- |An IRC message.
|
||||
data IrcMsg = IrcMsg (Maybe String) String [String] -- (Maybe first statement) cmd [chan, params/sentence]
|
||||
deriving (Show)
|
||||
|
||||
--ircParser :: String -> IrcInput
|
||||
ircParser :: String -> Either ParseError IrcMsg
|
||||
ircParser str = parse pMsg "" str
|
||||
|
||||
pMsg = do
|
||||
pfx <- optionMaybe pPrefix
|
||||
cmd <- pCommand
|
||||
params <- many (char ' ' >> (pLongParam <|> pShortParam))
|
||||
char '\r'
|
||||
eof
|
||||
return $ IrcMsg pfx cmd params
|
||||
|
||||
pPrefix = do
|
||||
char ':'
|
||||
pfx <- many1 (noneOf " ")
|
||||
space
|
||||
return pfx
|
||||
|
||||
pCommand = count 3 digit <|> many1 upper
|
||||
|
||||
pLongParam = char ':' >> (many1 (noneOf "\r"))
|
||||
|
||||
pShortParam = many1 (noneOf " \r")
|
||||
|
|
@ -41,28 +41,30 @@ imain' modul' reboot bot = do
|
|||
monitor :: (Chan IrcLine) -> Bot -> IO Bot
|
||||
monitor chan bot = do
|
||||
loop bot
|
||||
where loop bot' = do
|
||||
input <- readChan chan
|
||||
case input of
|
||||
Reboot ->do
|
||||
where
|
||||
loop bot' = do
|
||||
input <- readChan chan :: IO IrcLine
|
||||
case input of
|
||||
Reboot -> do
|
||||
putStrLn "Got reboot message, rebooting"
|
||||
return bot'
|
||||
Str str -> putStrLn ("received : " ++ str) >> loop bot'
|
||||
_ -> loop bot'
|
||||
|
||||
-- | Thread entry point for socket listeners
|
||||
listener :: (Chan IrcLine) -> (IrcServer, Handle) -> IO ()
|
||||
listener chan (server, handle) = forever $ do
|
||||
str <- hGetLine handle
|
||||
writeChan chan (Str str)
|
||||
if ping str then pong handle str
|
||||
else eval (parseIrcMsg str)
|
||||
let msg = parseIrcMsg str
|
||||
writeChan chan msg
|
||||
eval msg
|
||||
where
|
||||
eval str
|
||||
| (Cmd user channel (cmd, args)) <- str = do
|
||||
let cmd' = tail cmd
|
||||
unless (null cmd') (parseCmds user cmd' args channel)
|
||||
parseCmds user cmd args channel
|
||||
| cmd == "reboot" = writeChan chan Reboot
|
||||
| otherwise = do
|
||||
putStrLn $"Unknown command : " ++ cmd
|
||||
eval :: IrcLine -> IO ()
|
||||
eval (Privmsg (statement, stuff')) = sendPrivmsg (server, handle) stuff'
|
||||
eval (Quit (ircServer, handle')) = return ()
|
||||
eval (Join (ircServer, handle')) = return ()
|
||||
eval (Part (ircServer, handle')) = return ()
|
||||
eval (Ping (string)) = do pong handle string
|
||||
eval stuff' = case stuff' of
|
||||
Reboot -> return ()
|
||||
Nil -> return ()
|
||||
|
||||
|
|
Reference in a new issue