Switched to Data.Text
parent
4776e0843d
commit
dd057f97be
|
@ -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
|
||||
|
|
|
@ -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 { .. }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue