A simple IRC bot written in Haskell
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

SongSearch.hs 2.6KB

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