GHC -Wall ed

.gitignore

@@ -4,3 +4,4 @@
 cabal.sandbox.config
 dist
 config.cfg
+*sublime*

Main.hs

@@ -12,7 +12,7 @@ import Data.Maybe
 import System.Environment
 import System.Exit
 
-import Network.IRC.Types
+import Network.IRC.Types (BotConfig(BotConfig))
 import Network.IRC.Client
 
 instance Configured a => Configured [a] where

Network/IRC/Client.hs

@@ -10,7 +10,7 @@ import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.State
 import Network
-import Prelude hiding (log, catch)
+import Prelude hiding (log)
 import System.IO
 import System.Time
 import System.Timeout
@@ -20,8 +20,10 @@ import Network.IRC.Handlers
 import Network.IRC.Protocol
 import Network.IRC.Types
 
+oneSec :: Int
 oneSec = 1000000
 
+log :: String -> IO ()
 log msg = getClockTime >>= \t -> printf "[%s] ** %s\n" (show t) msg
 
 sendCommand :: Bot -> Command -> IO ()
@@ -43,10 +45,10 @@ listen = do
     case mLine of
       Nothing -> return Disconnected
       Just line -> do
-        time <- getClockTime
+        now <- getClockTime
-        printf "[%s] %s\n" (show time) line
+        printf "[%s] %s\n" (show now) line
 
-        let message = msgFromLine botConfig time (T.pack line)
+        let message = msgFromLine botConfig now (T.pack line)
         case message of
           JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined
           KickMsg { .. } | kicked == nick        -> log "Kicked" >> return Kicked
@@ -54,11 +56,15 @@ listen = do
             forkIO $ case message of
               Ping { .. }                 -> sendCommand bot $ Pong msg
               ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd
-              msg                         -> forM_ (handlers botConfig) $ \handler -> forkIO $ do
+              msg                         -> forM_ (handlers botConfig) $ \handlerName -> forkIO $ do
-                cmd <- runHandler (getHandler handler) botConfig msg
+                let mHandler = getHandler handlerName
-                case cmd of
+                case mHandler of
-                  Nothing  -> return ()
+                  Nothing      -> log $ "No handler found with name: " ++ T.unpack handlerName
-                  Just cmd -> sendCommand bot cmd
+                  Just handler -> do
+                    mCmd <- runHandler handler botConfig msg
+                    case mCmd of
+                      Nothing  -> return ()
+                      Just cmd -> sendCommand bot cmd
             return status
 
   put nStatus
@@ -67,11 +73,11 @@ listen = do
 connect :: BotConfig -> IO Bot
 connect botConfig@BotConfig { .. } = do
   log "Connecting ..."
-  handle <- connectToWithRetry
+  socket <- connectToWithRetry
-  hSetBuffering handle LineBuffering
+  hSetBuffering socket LineBuffering
   hSetBuffering stdout LineBuffering
   log "Connected"
-  return $ Bot botConfig handle
+  return $ Bot botConfig socket
   where
     connectToWithRetry = connectTo server (PortNumber (fromIntegral port))
                            `catch` (\(e :: SomeException) -> do
@@ -93,6 +99,7 @@ run botConfig = withSocketsDo $ do
   case status of
     Disconnected -> log "Connection timed out" >> run botConfig
     Errored      -> return ()
+    _            -> error "Unsupported status"
   where
     run_ = bracket (connect botConfig) disconnect $ \bot ->
       go bot `catch` \(e :: SomeException) -> do

Network/IRC/Handlers.hs

@@ -10,14 +10,19 @@ import Prelude hiding ((++))
 import Network.IRC.Handlers.SongSearch
 import Network.IRC.Types
 
+clean :: Text -> Text
 clean = toLower . strip
+
+(++) :: Text -> Text -> Text
 (++) = append
 
-getHandler :: HandlerName -> Handler
+getHandler :: HandlerName -> Maybe Handler
-getHandler "greeter"    = Handler greeter
+getHandler "greeter"    = Just $ Handler greeter
-getHandler "welcomer"   = Handler welcomer
+getHandler "welcomer"   = Just $ Handler welcomer
-getHandler "songsearch" = Handler songSearch
+getHandler "songsearch" = Just $ Handler songSearch
+getHandler _            = Nothing
 
+greeter :: Monad m => BotConfig -> Message -> m (Maybe Command)
 greeter _ ChannelMsg { .. } = case L.find (== clean msg) greetings of
     Nothing       -> return Nothing
     Just greeting -> return . Just . ChannelMsgReply $ greeting ++ " " ++ userNick user
@@ -27,6 +32,7 @@ greeter _ ChannelMsg { .. } = case L.find (== clean msg) greetings of
                 , "ohayo", "oyasumi"]
 greeter _ _ = return Nothing
 
+welcomer :: Monad m => BotConfig -> Message -> m (Maybe Command)
 welcomer BotConfig { .. } JoinMsg { .. }
   | userNick user /= botNick = return . Just . ChannelMsgReply $ "welcome back " ++ userNick user
 welcomer _ _ = return Nothing

Network/IRC/Handlers/SongSearch.hs

@@ -10,15 +10,12 @@ import Data.Aeson
 import Data.Aeson.Types (emptyArray)
 import Data.Configurator
 import Data.Text
-import Data.Text.IO
 import Network.Curl.Aeson
 import Network.HTTP.Base
 import Prelude hiding (putStrLn, drop, lookup)
 
 import Network.IRC.Types
 
-(+++) = append
-
 data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
             deriving (Show, Eq)
 
@@ -27,7 +24,8 @@ instance FromJSON Song where
     parseJSON a | a == emptyArray = return NoSong
     parseJSON _                   = mzero
 
-songSearch bot@BotConfig { .. } ChannelMsg { .. }
+songSearch :: MonadIO m => BotConfig -> Message -> m (Maybe Command)
+songSearch BotConfig { .. } ChannelMsg { .. }
   | "!m " `isPrefixOf` msg = liftIO $ do
       let query = strip . drop 3 $ msg
       mApiKey <- lookup config "songsearch.tinysong_apikey"
@@ -45,4 +43,6 @@ songSearch bot@BotConfig { .. } ChannelMsg { .. }
               Song { .. } -> "Listen to " +++ artist +++ " - " +++ name +++ " at " +++ url
               NoSong      -> "No song found for: " +++ query
   | otherwise = return Nothing
+  where
+    (+++) = append
 songSearch _ _ = return Nothing

Network/IRC/Protocol.hs

@@ -10,8 +10,6 @@ import System.Time
 
 import Network.IRC.Types
 
-(++) = append
-
 msgFromLine :: BotConfig -> ClockTime -> Text -> Message
 msgFromLine (BotConfig { .. }) time line
   | "PING :" `isPrefixOf` line = Ping time . drop 6 $ line
@@ -50,3 +48,5 @@ lineFromCommand (BotConfig { .. }) reply = case reply of
   JoinCmd                         -> "JOIN " ++ channel
   ChannelMsgReply { .. }          -> "PRIVMSG " ++ channel ++ " :" ++ rmsg
   PrivMsgReply (User { .. }) rmsg -> "PRIVMSG " ++ botNick ++ " :" ++ rmsg
+  where
+    (++) = append

Network/IRC/Types.hs

@@ -1,11 +1,10 @@
-{-# LANGUAGE RecordWildCards, DeriveDataTypeable, RankNTypes, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards, RankNTypes, GeneralizedNewtypeDeriving #-}
 
 module Network.IRC.Types where
 
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Configurator.Types
-import Data.Dynamic
 import Data.Text (Text)
 import System.IO
 import System.Time
@@ -68,5 +67,4 @@ newtype IRC a = IRC { _runIRC :: StateT BotStatus (ReaderT Bot IO) a }
                 deriving (Functor, Monad, MonadIO, MonadReader Bot, MonadState BotStatus)
 
 runIRC :: Bot -> BotStatus -> IRC a -> IO BotStatus
-runIRC bot botStatus irc =
+runIRC bot botStatus = flip runReaderT bot . flip execStateT botStatus . _runIRC
-  fmap snd $ runReaderT (runStateT (_runIRC irc) Connected) bot

hask-irc.cabal

@@ -58,6 +58,9 @@ library
 
   default-language:    Haskell2010
 
+  ghc-options:         -Wall -fno-warn-unused-do-bind -O2 -funbox-strict-fields
+
+
 executable hask-irc
   -- .hs or .lhs file containing the Main module.
   main-is:             Main.hs
@@ -66,7 +69,7 @@ executable hask-irc
   -- other-modules:
 
   -- LANGUAGE extensions used by modules in this package.
-  other-extensions:    RecordWildCards, OverloadedStrings, ScopedTypeVariables
+  other-extensions:    RecordWildCards, OverloadedStrings, ScopedTypeVariables, OverlappingInstances
 
   -- Other library packages from which modules are imported.
   build-depends:       base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
@@ -79,3 +82,5 @@ executable hask-irc
   -- Base language which the package is written in.
   default-language:    Haskell2010
 
+  ghc-options:         -Wall -fno-warn-unused-do-bind -funbox-strict-fields
+