hask-irc/hask-irc-handlers/Network/IRC/Handlers/SongSearch.hs

65 regels
2.6 KiB
Haskell

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Handlers.SongSearch (songSearchMsgHandlerMaker) where
import qualified System.Log.Logger as HSL
import ClassyPrelude
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)
import qualified Network.IRC.Configuration as CF
import Network.IRC
$(deriveLoggers "HSL" [HSL.ERROR])
songSearchMsgHandlerMaker :: MsgHandlerMaker
songSearchMsgHandlerMaker = MsgHandlerMaker "songsearch" go
where
helpMsg = "Search for song. !m <song> or !m <artist> - <song>"
go _ _ =
return $ newMsgHandler { onMessage = songSearch
, handlerHelp = return $ singletonMap "!m" helpMsg }
data Song = NoSong | Song { url :: Text, name :: Text, artist :: Text }
deriving (Show, Eq)
instance FromJSON Song where
parseJSON (Object o) = Song <$> o .: "Url" <*> o .: "SongName" <*> o .: "ArtistName"
parseJSON a | a == emptyArray = return NoSong
parseJSON _ = mempty
songSearch :: MonadMsgHandler m => Message -> m [Message]
songSearch Message { .. }
| Just (ChannelMsg _ msg) <- fromMessage message
, "!m " `isPrefixOf` msg = do
BotConfig { .. } <- ask
liftIO $ do
let query = strip . drop 3 $ msg
let mApiKey = CF.lookup "songsearch.tinysong_apikey" config
reply <- map ChannelMsgReply $ case mApiKey of
Nothing -> do
errorM "tinysong api key not found in config"
return $ "Error while searching for " ++ query
Just (apiKey :: Text) -> do
let apiUrl = "http://tinysong.com/b/" ++ urlEncode (unpack query)
++ "?format=json&key=" ++ unpack apiKey
result <- try $ curlAesonGet apiUrl >>= evaluate
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
Song { .. } -> "Listen to " ++ artist ++ " - " ++ name ++ " at " ++ url
NoSong -> "No song found for: " ++ query
map singleton . newMessage $ reply
| otherwise = return []