Switched to Data.Text

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
+sendCommand Bot { .. } reply = do
-  let line = lineFromCommand botConfig reply
+  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

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 { .. }

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 channel  = T.pack $ args !! 2
-  let botNick  = args !! 3
+  let botNick  = T.pack $ args !! 3
-  let handlers = ["greeter", "welcomer"]
+  let handlers = map T.pack ["greeter", "welcomer"]
 
   if length args < 4
     then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure

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 qualified Data.List as L
-import Data.List.Split
+
+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
+    message    = drop 1 . unwords . L.drop 3 $ splits
-    user       = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1)
+    user       = let u = split (== '!') source in User (u !! 0) (u !! 1)
     mode       = splits !! 3
-    modeArgs   = drop 4 splits
+    modeArgs   = L.drop 4 splits
-    kickReason = drop 1 . unwords . 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

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 Channel     = Text
-type Nick        = String
+type Nick        = Text
-type HandlerName = String
+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 }
+    ChannelMsg { time :: ClockTime, user :: User, msg :: Text }
-  | PrivMsg    { time :: ClockTime, user :: User, msg :: String }
+  | PrivMsg    { time :: ClockTime, user :: User, msg :: Text }
-  | Ping       { time :: ClockTime, msg :: String }
+  | Ping       { time :: ClockTime, msg :: Text }
   | JoinMsg    { time :: ClockTime, user :: User }
-  | ModeMsg    { time :: ClockTime, user :: User, target :: String
+  | ModeMsg    { time :: ClockTime, user :: User, target :: Text
-               , mode :: String, modeArgs :: [String] }
+               , mode :: Text, modeArgs :: [Text] }
-  | NickMsg    { time :: ClockTime, user :: User, nick :: String }
+  | NickMsg    { time :: ClockTime, user :: User, nick :: Text }
-  | QuitMsg    { time :: ClockTime, user :: User, msg :: String }
+  | QuitMsg    { time :: ClockTime, user :: User, msg :: Text }
-  | PartMsg    { time :: ClockTime, user :: User, msg :: String }
+  | PartMsg    { time :: ClockTime, user :: User, msg :: Text }
-  | KickMsg    { time :: ClockTime, user :: User, msg :: String }
+  | KickMsg    { time :: ClockTime, user :: User, msg :: Text }
-  | OtherMsg   { time :: ClockTime, source :: String, command :: String
+  | OtherMsg   { time :: ClockTime, source :: Text, command :: Text
-               , target :: String, msg :: String }
+               , target :: Text, msg :: Text }
   deriving (Show, Eq)
 
 data Command =
-    Pong            { rmsg :: String }
+    Pong            { rmsg :: Text }
-  | ChannelMsgReply { rmsg :: String }
+  | ChannelMsgReply { rmsg :: Text }
-  | PrivMsgReply    { ruser :: User, rmsg :: String }
+  | PrivMsgReply    { ruser :: User, rmsg :: Text }
   | NickCmd
   | UserCmd
   | JoinCmd
@@ -38,8 +39,8 @@ data Command =
 
 data BotConfig = BotConfig { server :: String
                            , port :: Int
-                           , channel :: String
+                           , channel :: Text
-                           , botNick :: String
+                           , botNick :: Text
                            , botTimeout :: Int
                            , handlers :: [HandlerName] }
                  deriving (Show, Eq)