First working commit
commit
140ae91b75
|
@ -0,0 +1,3 @@
|
|||
*.hi
|
||||
*.o
|
||||
Network/IRC/Main
|
|
@ -0,0 +1,51 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Handlers(listen, sendCommand) where
|
||||
|
||||
import Control.Concurrent
|
||||
import Control.Monad.Reader
|
||||
import Data.List
|
||||
import System.IO
|
||||
import System.Time
|
||||
import Text.Printf
|
||||
|
||||
import Network.IRC.Protocol
|
||||
import Network.IRC.Types
|
||||
|
||||
io = liftIO
|
||||
|
||||
sendCommand :: Bot -> Command -> IO ()
|
||||
sendCommand bot@Bot{ .. } reply = do
|
||||
let line = lineFromCommand bot reply
|
||||
hPrintf socket "%s\r\n" line >> printf "> %s\n" line
|
||||
|
||||
|
||||
listen :: IRC ()
|
||||
listen = forever $ do
|
||||
bot@Bot{ .. } <- ask
|
||||
|
||||
line <- fmap init $ io $ hGetLine socket
|
||||
time <- io getClockTime
|
||||
|
||||
io $ printf "[%s] %s\n" (show time) line
|
||||
|
||||
io $ forkIO $ case msgFromLine bot time line of
|
||||
Ping { .. } -> sendCommand bot $ Pong msg
|
||||
ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd
|
||||
msg -> forM_ messageHandlers $ \handler -> handler bot msg
|
||||
|
||||
messageHandlers = [greeter, welcomer]
|
||||
|
||||
greeter bot ChannelMsg { .. } = case find (`isPrefixOf` msg) greetings of
|
||||
Nothing -> return ()
|
||||
Just greeting -> sendCommand bot $ ChannelMsgReply $ greeting ++ " " ++ userNick user
|
||||
where
|
||||
greetings = ["hi", "hello", "hey", "sup", "bye"
|
||||
, "good morning", "good evening", "good night"
|
||||
, "ohayo", "oyasumi"]
|
||||
greeter _ _ = return ()
|
||||
|
||||
welcomer bot@Bot { .. } JoinMsg { .. }
|
||||
| userNick user /= botNick =
|
||||
sendCommand bot $ ChannelMsgReply $ "welcome back " ++ userNick user
|
||||
welcomer _ _ = return ()
|
|
@ -0,0 +1,45 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Network.IRC.Main(main) where
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import Control.Monad.Reader
|
||||
import Network
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO
|
||||
|
||||
import Network.IRC.Handlers
|
||||
import Network.IRC.Protocol
|
||||
import Network.IRC.Types
|
||||
|
||||
io = liftIO
|
||||
|
||||
connect server port channel botNick = do
|
||||
putStrLn "** Connecting ..."
|
||||
handle <- connectTo server (PortNumber (fromIntegral port))
|
||||
hSetBuffering handle LineBuffering
|
||||
hSetBuffering stdout LineBuffering
|
||||
putStrLn "** Connected"
|
||||
return $ Bot server port channel botNick handle
|
||||
|
||||
disconnect bot = do
|
||||
putStrLn "** Disconnecting ..."
|
||||
hClose . socket $ bot
|
||||
putStrLn "** Disconnected"
|
||||
|
||||
run = do
|
||||
bot <- ask
|
||||
io $ sendCommand bot NickCmd >> sendCommand bot UserCmd
|
||||
listen
|
||||
|
||||
main = do
|
||||
args <- getArgs
|
||||
prog <- getProgName
|
||||
if length args < 4
|
||||
then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure
|
||||
else E.bracket (connect (args !! 0) (read (args !! 1)) (args !! 2) (args !! 3))
|
||||
disconnect loop
|
||||
where
|
||||
loop st = E.catch (runReaderT run st)
|
||||
(\(e :: E.SomeException) -> putStrLn $ "Exception! " ++ show e)
|
|
@ -0,0 +1,45 @@
|
|||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
module Network.IRC.Protocol where
|
||||
|
||||
import Data.List
|
||||
import Data.List.Split
|
||||
import System.Time
|
||||
|
||||
import Network.IRC.Types
|
||||
|
||||
msgFromLine :: Bot -> ClockTime -> String -> Message
|
||||
msgFromLine (Bot { .. }) time line
|
||||
| "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
|
||||
| otherwise = case command of
|
||||
"JOIN" -> JoinMsg time user
|
||||
"QUIT" -> QuitMsg time user message
|
||||
"PART" -> PartMsg time user message
|
||||
"MODE" -> if source == botNick
|
||||
then ModeMsg time Self target message []
|
||||
else ModeMsg time user target mode modeArgs
|
||||
"NICK" -> NickMsg time user (drop 1 target)
|
||||
"PRIVMSG" -> if target == channel
|
||||
then ChannelMsg time user message
|
||||
else PrivMsg time user message
|
||||
_ -> OtherMsg time source command target message
|
||||
where
|
||||
isSpc = (== ' ')
|
||||
isNotSpc = not . isSpc
|
||||
splits = splitWhen isSpc line
|
||||
source = drop 1 . takeWhile isNotSpc $ line
|
||||
target = splits !! 2
|
||||
command = splits !! 1
|
||||
message = drop 1 . unwords . drop 3 $ splits
|
||||
user = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1)
|
||||
mode = splits !! 3
|
||||
modeArgs = drop 4 splits
|
||||
|
||||
lineFromCommand :: Bot -> Command -> String
|
||||
lineFromCommand (Bot { .. }) reply = case reply of
|
||||
Pong { .. } -> "PONG :" ++ rmsg
|
||||
NickCmd -> "NICK " ++ botNick
|
||||
UserCmd -> "USER " ++ botNick ++ " 0 * :" ++ botNick
|
||||
JoinCmd -> "JOIN " ++ channel
|
||||
ChannelMsgReply { .. } -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
|
||||
PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg
|
|
@ -0,0 +1,42 @@
|
|||
module Network.IRC.Types where
|
||||
|
||||
import Control.Monad.Reader
|
||||
import System.IO
|
||||
import System.Time
|
||||
|
||||
type Channel = String
|
||||
type Nick = String
|
||||
|
||||
data User = Self | User { userNick :: Nick, userServer :: String }
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Message =
|
||||
ChannelMsg { time :: ClockTime, user :: User, msg :: String }
|
||||
| PrivMsg { time :: ClockTime, user :: User, msg :: String }
|
||||
| Ping { time :: ClockTime, msg :: String }
|
||||
| JoinMsg { time :: ClockTime, user :: User }
|
||||
| ModeMsg { time :: ClockTime, user :: User, target :: String
|
||||
, mode :: String, modeArgs :: [String] }
|
||||
| NickMsg { time :: ClockTime, user :: User, nick :: String }
|
||||
| QuitMsg { time :: ClockTime, user :: User, msg :: String }
|
||||
| PartMsg { time :: ClockTime, user :: User, msg :: String }
|
||||
| OtherMsg { time :: ClockTime, source :: String, command :: String
|
||||
, target :: String, msg :: String }
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Command =
|
||||
Pong { rmsg :: String }
|
||||
| ChannelMsgReply { rmsg :: String }
|
||||
| PrivMsgReply { ruser :: User, rmsg :: String }
|
||||
| NickCmd
|
||||
| UserCmd
|
||||
| JoinCmd
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Bot = Bot { server :: String
|
||||
, port :: Int
|
||||
, channel :: String
|
||||
, botNick :: String
|
||||
, socket :: Handle }
|
||||
|
||||
type IRC = ReaderT Bot IO
|
Loading…
Reference in New Issue