diff --git a/.gitignore b/.gitignore index 895c06f..8d8dadb 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ .cabal-sandbox cabal.sandbox.config dist +config.cfg diff --git a/Main.hs b/Main.hs index 5741bfb..052fb56 100644 --- a/Main.hs +++ b/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 ++ " ") >> 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 ++ " ") >> exitFailure + else run $ BotConfig server port channel botNick timeout handlers cfg diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index 1ebd2ba..a2566ae 100644 --- a/Network/IRC/Client.hs +++ b/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 diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index b31f875..e93988b 100644 --- a/Network/IRC/Handlers.hs +++ b/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 { .. } diff --git a/Network/IRC/Handlers/SongSearch.hs b/Network/IRC/Handlers/SongSearch.hs new file mode 100644 index 0000000..d8e274a --- /dev/null +++ b/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 diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index b1b231b..8086903 100644 --- a/Network/IRC/Types.hs +++ b/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 diff --git a/config.cfg.template b/config.cfg.template new file mode 100644 index 0000000..b1977c1 --- /dev/null +++ b/config.cfg.template @@ -0,0 +1,9 @@ +server = "irc.freenode.net" +port = 6667 +channel = "#testtesttest" +nick = "haskman" +handlers = ["greeter", "welcomer"] + +songsearch { + tinysong_apikey = "xxxyyyzzz" +} diff --git a/hask-irc.cabal b/hask-irc.cabal index a6f0f40..ca123ba 100644 --- a/hask-irc.cabal +++ b/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: