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

63 lines
2.5 KiB
Haskell

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
module Network.IRC.Handlers.SongSearch (mkMsgHandler) where
import qualified Data.Configurator as CF
import qualified System.Log.Logger as HSL
import ClassyPrelude
import Control.Concurrent.Lifted (Chan)
import Control.Exception.Lifted (evaluate)
import Control.Monad.Reader (ask)
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 Network.IRC.Types
$(deriveLoggers "HSL" [HSL.ERROR])
mkMsgHandler :: BotConfig -> Chan SomeEvent -> MsgHandlerName -> IO (Maybe MsgHandler)
mkMsgHandler _ _ "songsearch" =
return . Just $ newMsgHandler { onMessage = songSearch,
onHelp = return $ singletonMap "!m" helpMsg }
where
helpMsg = "Search for song. !m <song> or !m <artist> - <song>"
mkMsgHandler _ _ _ = return Nothing
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 (Maybe Command)
songSearch Message { msgDetails = ChannelMsg { .. }, .. }
| "!m " `isPrefixOf` msg = do
BotConfig { .. } <- ask
liftIO $ do
let query = strip . drop 3 $ msg
mApiKey <- CF.lookup config "songsearch.tinysong_apikey"
map (Just . ChannelMsgReply) $ case mApiKey of
Nothing -> do
errorM "tinysong api key not found in config"
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
return $ 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