abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Switched to Data.Text

master
Abhinav Sarkar 2014-05-04 07:43:37 +05:30
parent 4776e0843d
commit dd057f97be
5 changed files with 61 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Network/IRC/Client.hs
View File

@ -1,6 +1,8 @@
{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
module Network.IRC.Client(run) where
module Network.IRC.Client (run) where
import qualified Data.Text as T
import Control.Exception
import Control.Concurrent
@ -26,13 +28,13 @@ io = liftIO
log msg = putStrLn $ "** " ++ msg
sendCommand :: Bot -> Command -> IO ()
sendCommand Bot{ .. } reply = do
let line = lineFromCommand botConfig reply
sendCommand Bot { .. } reply = do
let line = T.unpack $ lineFromCommand botConfig reply
hPrintf socket "%s\r\n" line >> printf "> %s\n" line
listen :: Status -> IRC Status
listen status = do
bot@Bot{ .. } <- ask
bot@Bot { .. } <- ask
let nick = botNick botConfig
when (status == Kicked) $
@ -47,7 +49,7 @@ listen status = do
io $ printf "[%s] %s\n" (show time) line
let message = msgFromLine botConfig time line
let message = msgFromLine botConfig time (T.pack line)
nStatus <- io $ case message of
JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined
KickMsg { .. } -> log "Kicked" >> return Kicked
@ -65,7 +67,7 @@ listen status = do
listen nStatus
connect :: BotConfig -> IO Bot
connect botConfig@BotConfig{ .. } = do
connect botConfig@BotConfig { .. } = do
log "Connecting ..."
handle <- connectToWithRetry
hSetBuffering handle LineBuffering

17
Network/IRC/Handlers.hs
View File

@ -1,23 +1,30 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Network.IRC.Handlers(handleMessage) where
module Network.IRC.Handlers (handleMessage) where
import Data.List
import qualified Data.List as L
import Data.Text
import Prelude hiding ((++))
import Network.IRC.Protocol
import Network.IRC.Types
handleMessage :: String -> Handler
(++) = append
handleMessage :: HandlerName -> Handler
handleMessage "greeter" = greeter
handleMessage "welcomer" = welcomer
greeter bot ChannelMsg { .. } = case find (`isPrefixOf` msg) greetings of
greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
Nothing -> return Nothing
Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user
where
greetings = ["hi", "hello", "hey", "sup", "bye"
, "good morning", "good evening", "good night"
, "ohayo", "oyasumi"]
clean = toLower . strip
greeter _ _ = return Nothing
welcomer bot@BotConfig { .. } JoinMsg { .. }

8
Network/IRC/Main.hs
View File

@ -1,5 +1,7 @@
module Network.IRC.Main(main) where
import qualified Data.Text as T
import System.Environment
import System.Exit
@ -13,9 +15,9 @@ main = do
let server = args !! 0
let port = read (args !! 1)
let channel = args !! 2
let botNick = args !! 3
let handlers = ["greeter", "welcomer"]
let channel = T.pack $ args !! 2
let botNick = T.pack $ args !! 3
let handlers = map T.pack ["greeter", "welcomer"]
if length args < 4
then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure

26
Network/IRC/Protocol.hs
View File

@ -1,14 +1,18 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Network.IRC.Protocol where
module Network.IRC.Protocol (msgFromLine, lineFromCommand) where
import Data.List
import Data.List.Split
import qualified Data.List as L
import Data.Text
import Prelude hiding (drop, unwords, takeWhile, (++))
import System.Time
import Network.IRC.Types
msgFromLine :: BotConfig -> ClockTime -> String -> Message
(++) = append
msgFromLine :: BotConfig -> ClockTime -> Text -> Message
msgFromLine (BotConfig { .. }) time line
| "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
| otherwise = case command of
@ -27,17 +31,17 @@ msgFromLine (BotConfig { .. }) time line
where
isSpc = (== ' ')
isNotSpc = not . isSpc
splits = splitWhen isSpc line
splits = split 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)
message = drop 1 . unwords . L.drop 3 $ splits
user = let u = split (== '!') source in User (u !! 0) (u !! 1)
mode = splits !! 3
modeArgs = drop 4 splits
kickReason = drop 1 . unwords . drop 4 $ splits
modeArgs = L.drop 4 splits
kickReason = drop 1 . unwords . L.drop 4 $ splits
lineFromCommand :: BotConfig -> Command -> String
lineFromCommand :: BotConfig -> Command -> Text
lineFromCommand (BotConfig { .. }) reply = case reply of
Pong { .. } -> "PONG :" ++ rmsg
NickCmd -> "NICK " ++ botNick

41
Network/IRC/Types.hs
View File

@ -1,36 +1,37 @@
module Network.IRC.Types where
import Control.Monad.Reader
import Data.Text (Text)
import System.IO
import System.Time
type Channel = String
type Nick = String
type HandlerName = String
type Channel = Text
type Nick = Text
type HandlerName = Text
type Handler = BotConfig -> Message -> IO (Maybe Command)
data User = Self | User { userNick :: Nick, userServer :: String }
data User = Self | User { userNick :: Nick, userServer :: Text }
deriving (Show, Eq)
data Message =
ChannelMsg { time :: ClockTime, user :: User, msg :: String }
| PrivMsg { time :: ClockTime, user :: User, msg :: String }
| Ping { time :: ClockTime, msg :: String }
ChannelMsg { time :: ClockTime, user :: User, msg :: Text }
| PrivMsg { time :: ClockTime, user :: User, msg :: Text }
| Ping { time :: ClockTime, msg :: Text }
| 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 }
| KickMsg { time :: ClockTime, user :: User, msg :: String }
| OtherMsg { time :: ClockTime, source :: String, command :: String
, target :: String, msg :: String }
| ModeMsg { time :: ClockTime, user :: User, target :: Text
, mode :: Text, modeArgs :: [Text] }
| NickMsg { time :: ClockTime, user :: User, nick :: Text }
| QuitMsg { time :: ClockTime, user :: User, msg :: Text }
| PartMsg { time :: ClockTime, user :: User, msg :: Text }
| KickMsg { time :: ClockTime, user :: User, msg :: Text }
| OtherMsg { time :: ClockTime, source :: Text, command :: Text
, target :: Text, msg :: Text }
deriving (Show, Eq)
data Command =
Pong { rmsg :: String }
| ChannelMsgReply { rmsg :: String }
| PrivMsgReply { ruser :: User, rmsg :: String }
Pong { rmsg :: Text }
| ChannelMsgReply { rmsg :: Text }
| PrivMsgReply { ruser :: User, rmsg :: Text }
| NickCmd
| UserCmd
| JoinCmd
@ -38,8 +39,8 @@ data Command =
data BotConfig = BotConfig { server :: String
, port :: Int
, channel :: String
, botNick :: String
, channel :: Text
, botNick :: Text
, botTimeout :: Int
, handlers :: [HandlerName] }
deriving (Show, Eq)