2014-05-13 00:00:33 +05:30
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2014-05-22 01:08:36 +05:30
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-06-07 00:50:27 +05:30
|
|
|
module Network.IRC.Handlers.SongSearch (songSearchMsgHandlerMaker) where
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-05-10 20:01:25 +05:30
|
|
|
import qualified Data.Configurator as CF
|
2014-05-22 01:08:36 +05:30
|
|
|
import qualified System.Log.Logger as HSL
|
2014-05-10 20:01:25 +05:30
|
|
|
|
2014-05-22 01:08:36 +05:30
|
|
|
import ClassyPrelude
|
2014-06-01 23:14:19 +05:30
|
|
|
import Control.Exception.Lifted (evaluate)
|
|
|
|
import Data.Aeson (FromJSON, parseJSON, Value (..), (.:))
|
|
|
|
import Data.Aeson.Types (emptyArray)
|
|
|
|
import Data.Text (strip)
|
|
|
|
import Network.Curl.Aeson (curlAesonGet, CurlAesonException)
|
|
|
|
import Network.HTTP.Base (urlEncode)
|
|
|
|
import System.Log.Logger.TH (deriveLoggers)
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
import Network.IRC
|
2014-05-22 01:08:36 +05:30
|
|
|
|
|
|
|
$(deriveLoggers "HSL" [HSL.ERROR])
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-06-07 00:50:27 +05:30
|
|
|
songSearchMsgHandlerMaker :: MsgHandlerMaker
|
|
|
|
songSearchMsgHandlerMaker = MsgHandlerMaker "songsearch" go
|
2014-05-22 20:59:02 +05:30
|
|
|
where
|
|
|
|
helpMsg = "Search for song. !m <song> or !m <artist> - <song>"
|
2014-06-02 00:26:41 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
go _ _ =
|
|
|
|
return $ newMsgHandler { onMessage = songSearch
|
|
|
|
, handlerHelp = return $ singletonMap "!m" helpMsg }
|
2014-05-11 14:01:09 +05:30
|
|
|
|
2014-05-04 16:50:19 +05:30
|
|
|
data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
|
2014-05-06 02:50:40 +05:30
|
|
|
deriving (Show, Eq)
|
2014-05-04 16:50:19 +05:30
|
|
|
|
|
|
|
instance FromJSON Song where
|
|
|
|
parseJSON (Object o) = Song <$> o .: "Url" <*> o .: "SongName" <*> o .: "ArtistName"
|
|
|
|
parseJSON a | a == emptyArray = return NoSong
|
2014-05-10 21:45:16 +05:30
|
|
|
parseJSON _ = mempty
|
2014-05-04 16:50:19 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
songSearch :: MonadMsgHandler m => Message -> m [Message]
|
|
|
|
songSearch Message { .. }
|
2014-06-08 04:26:50 +05:30
|
|
|
| Just (ChannelMsg _ msg) <- fromMessage message
|
|
|
|
, "!m " `isPrefixOf` msg = do
|
2014-05-20 02:40:08 +05:30
|
|
|
BotConfig { .. } <- ask
|
|
|
|
liftIO $ do
|
|
|
|
let query = strip . drop 3 $ msg
|
2014-10-04 21:22:24 +05:30
|
|
|
mApiKey <- CF.lookup config "songsearch.tinysong_apikey"
|
|
|
|
reply <- map ChannelMsgReply $ case mApiKey of
|
2014-05-21 12:17:00 +05:30
|
|
|
Nothing -> do
|
2014-05-22 01:08:36 +05:30
|
|
|
errorM "tinysong api key not found in config"
|
2014-05-20 02:40:08 +05:30
|
|
|
return $ "Error while searching for " ++ query
|
|
|
|
Just apiKey -> do
|
|
|
|
let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query)
|
|
|
|
++ "?format=json&key=" ++ apiKey
|
|
|
|
|
|
|
|
result <- try $ curlAesonGet apiUrl >>= evaluate
|
2014-06-08 04:26:50 +05:30
|
|
|
case result of
|
|
|
|
Left (e :: CurlAesonException) -> do
|
|
|
|
errorM . unpack $ "Error while searching for " ++ query ++ ": " ++ pack (show e)
|
|
|
|
return $ "Error while searching for " ++ query
|
|
|
|
Right song -> return $ case song of
|
2014-05-20 02:40:08 +05:30
|
|
|
Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url
|
|
|
|
NoSong -> "No song found for: " ++ query
|
2014-10-04 21:22:24 +05:30
|
|
|
map singleton . newMessage $ reply
|
2014-06-01 06:48:24 +05:30
|
|
|
| otherwise = return []
|