Added support for reading configs from file, added songsearch handler

.gitignore

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

Main.hs

@@ -1,24 +1,38 @@
+{-# LANGUAGE OverloadedStrings, OverlappingInstances #-}
+
 module Main (main) where
 
 import qualified Data.Text as T
 
+import qualified Data.Configurator as C
+import Data.Configurator.Types
+
+import Data.Maybe
 import System.Environment
 import System.Exit
 
 import Network.IRC.Types
 import Network.IRC.Client
 
+instance Configured a => Configured [a] where
+  convert (List xs) = Just . mapMaybe convert $ xs
+  convert _ = Nothing
+
 main :: IO ()
 main = do
   args <- getArgs
   prog <- getProgName
 
-  let server   = args !! 0
-  let port     = read (args !! 1)
-  let channel  = T.pack $ args !! 2
-  let botNick  = T.pack $ args !! 3
-  let handlers = map T.pack ["greeter", "welcomer"]
+  let configFile = head args
+  cfg <- C.load [C.Required configFile]
 
-  if length args < 4
-    then putStrLn ("Usage: " ++ prog ++ " <server> <port> <channel> <nick>") >> exitFailure
-    else run $ BotConfig server port channel botNick 180 handlers
+  server   <- C.require cfg "server"
+  port     <- C.require cfg "port"
+  channel  <- C.require cfg "channel"
+  botNick  <- C.require cfg "nick"
+  timeout  <- C.require cfg "timeout"
+  handlers <- C.require cfg "handlers"
+
+  if length args < 1
+    then putStrLn ("Usage: " ++ prog ++ " <config file path>") >> exitFailure
+    else run $ BotConfig server port channel botNick timeout handlers cfg

Network/IRC/Client.hs

@@ -89,6 +89,8 @@ disconnect bot = do
 
 run :: BotConfig -> IO ()
 run botConfig = withSocketsDo $ do
+  log "Running with config:"
+  print botConfig
   status <- run_
   case status of
     Disconnected -> log "Connection timed out" >> run botConfig

Network/IRC/Handlers.hs

@@ -7,14 +7,16 @@ import qualified Data.List as L
 import Data.Text
 import Prelude hiding ((++))
 
-import Network.IRC.Protocol
+import Network.IRC.Handlers.SongSearch
 import Network.IRC.Types
 
+clean = toLower . strip
 (++) = append
 
 handleMessage :: HandlerName -> Handler
-handleMessage "greeter"  = greeter
-handleMessage "welcomer" = welcomer
+handleMessage "greeter"    = greeter
+handleMessage "welcomer"   = welcomer
+handleMessage "songsearch" = songSearch
 
 greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
     Nothing       -> return Nothing
@@ -24,7 +26,6 @@ greeter bot ChannelMsg { .. } = case L.find (== clean msg) greetings of
                 , "good morning", "good evening", "good night"
                 , "ohayo", "oyasumi"]
 
-    clean = toLower . strip
 greeter _ _ = return Nothing
 
 welcomer bot@BotConfig { .. } JoinMsg { .. }

Network/IRC/Handlers/SongSearch.hs

@@ -0,0 +1,45 @@
+{-# LANGUAGE RecordWildCards, OverloadedStrings, ScopedTypeVariables, BangPatterns #-}
+
+module Network.IRC.Handlers.SongSearch (songSearch) where
+
+import qualified Data.Configurator as C
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import Data.Aeson
+import Data.Aeson.Types (emptyArray)
+import Data.Text
+import Data.Text.IO
+import Network.Curl.Aeson
+import Network.HTTP.Base
+import Prelude hiding (putStrLn, drop)
+
+import Network.IRC.Types
+
+(+++) = append
+
+data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
+            deriving (Show)
+
+instance FromJSON Song where
+    parseJSON (Object o)          = Song <$> o .: "Url" <*> o .: "SongName" <*> o .: "ArtistName"
+    parseJSON a | a == emptyArray = return NoSong
+    parseJSON _                   = mzero
+
+songSearch bot@BotConfig { .. } ChannelMsg { .. }
+  | "!m " `isPrefixOf` msg = do
+      let query = strip . drop 3 $ msg
+      apiKey <- C.require config "songsearch.tinysong_apikey"
+      let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query)
+                    ++ "?format=json&key=" ++ apiKey
+
+      result <- try $ curlAesonGet apiUrl >>= evaluate
+
+      return . Just . ChannelMsgReply $ case result of
+        Left (_ :: CurlAesonException) -> "Error while searching for " +++ query
+        Right song                     -> case song of
+          Song { .. } -> "Listen to " +++ artist +++ " - " +++ name +++ " at " +++ url
+          NoSong      -> "No song found for: " +++ query
+  | otherwise = return Nothing
+songSearch _ _ = return Nothing

Network/IRC/Types.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Network.IRC.Types where
 
 import Control.Monad.Reader
+import Data.Configurator.Types
 import Data.Text (Text)
 import System.IO
 import System.Time
@@ -40,8 +43,17 @@ data BotConfig = BotConfig { server     :: String
                            , channel    :: Text
                            , botNick    :: Text
                            , botTimeout :: Int
-                           , handlers   :: [HandlerName] }
-                 deriving (Show, Eq)
-data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show, Eq)
+                           , handlers   :: [HandlerName]
+                           , config     :: Config }
+
+instance Show BotConfig where
+  show BotConfig { .. } = "server = " ++ show server ++ "\n" ++
+                          "port = " ++ show port ++ "\n" ++
+                          "channel = " ++ show channel ++ "\n" ++
+                          "nick = " ++ show botNick ++ "\n" ++
+                          "timeout = " ++ show botTimeout ++ "\n" ++
+                          "handlers = " ++ show handlers ++ "\n"
+
+data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show)
 
 type IRC = ReaderT Bot IO

config.cfg.template

@@ -0,0 +1,9 @@
+server = "irc.freenode.net"
+port = 6667
+channel = "#testtesttest"
+nick = "haskman"
+handlers = ["greeter", "welcomer"]
+
+songsearch {
+  tinysong_apikey = "xxxyyyzzz"
+}

hask-irc.cabal

@@ -60,8 +60,9 @@ executable hask-irc
   other-extensions:    RecordWildCards, OverloadedStrings, ScopedTypeVariables
 
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.6 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
-                       network >=2.4 && <2.5, old-time >=1.1 && <1.2
+  build-depends:       base >=4.5 && <4.7, text >=0.11 && <0.12, mtl >=2.1 && <2.2,
+                       network >=2.3 && <2.5, old-time >=1.1 && <1.2, configurator >= 0.2,
+                       curl-aeson ==0.0.3, aeson >=0.6.0.0, HTTP
 
   -- Directories containing source files.
   -- hs-source-dirs: