From dd057f97be34474ebb83b8081dbd1336b4949e81 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 4 May 2014 07:43:37 +0530 Subject: [PATCH] Switched to Data.Text --- Network/IRC/Client.hs | 14 ++++++++------ Network/IRC/Handlers.hs | 17 ++++++++++++----- Network/IRC/Main.hs | 8 +++++--- Network/IRC/Protocol.hs | 26 +++++++++++++++----------- Network/IRC/Types.hs | 41 +++++++++++++++++++++-------------------- 5 files changed, 61 insertions(+), 45 deletions(-) diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index 68e8dd8..640413e 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -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 diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index 87e30f2..1a17911 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -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 { .. } diff --git a/Network/IRC/Main.hs b/Network/IRC/Main.hs index d2a008a..4ab4e39 100644 --- a/Network/IRC/Main.hs +++ b/Network/IRC/Main.hs @@ -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 ++ " ") >> exitFailure diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index e888138..3552b7d 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -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 diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index 88154d4..bfae30a 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -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)