From 9518f71bed189b68b3249ae9e3784910847787b4 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 24 Aug 2018 00:33:13 +0700 Subject: [PATCH 1/5] (#79) Implement !song command --- HyperNerd.cabal | 1 + src/Bot.hs | 6 ++++ src/Bot/Dubtrack.hs | 67 +++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 74 insertions(+) create mode 100644 src/Bot/Dubtrack.hs diff --git a/HyperNerd.cabal b/HyperNerd.cabal index 818502a..2a1b2a2 100644 --- a/HyperNerd.cabal +++ b/HyperNerd.cabal @@ -62,6 +62,7 @@ executable HyperNerd other-modules: Bot , Bot.BttvFfz , Bot.CustomCommand + , Bot.Dubtrack , Bot.Links , Bot.Log , Bot.Periodic diff --git a/src/Bot.hs b/src/Bot.hs index 0fc8875..db677e5 100644 --- a/src/Bot.hs +++ b/src/Bot.hs @@ -3,6 +3,7 @@ module Bot (Bot, bot, Event(..), Sender(..), TwitchStream(..)) where import Bot.BttvFfz import Bot.CustomCommand +import Bot.Dubtrack import Bot.Log import Bot.Periodic import Bot.Poll @@ -66,8 +67,13 @@ builtinCommands = $ regexArgsCommand "([a-zA-Z0-9]+) ?(.*)" $ pairArgsCommand $ updateCustomCommand builtinCommands)) + , ("song", ("Print currently playing song", noArgsCommand $ currentSongCommand)) ] +noArgsCommand :: CommandHandler () -> CommandHandler a +noArgsCommand commandHandler sender _ = + commandHandler sender () + authorizeCommand :: [T.Text] -> CommandHandler a -> CommandHandler a authorizeCommand authorizedPeople commandHandler sender args = if senderName sender `elem` authorizedPeople diff --git a/src/Bot/Dubtrack.hs b/src/Bot/Dubtrack.hs new file mode 100644 index 0000000..87177fb --- /dev/null +++ b/src/Bot/Dubtrack.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE OverloadedStrings #-} +module Bot.Dubtrack where + +import Bot.Replies +import Command +import Data.Aeson +import Data.Aeson.Types +import qualified Data.Text as T +import Effect +import Network.HTTP.Simple + +data SongType = SongTypeYoutube + | SongTypeSoundcloud + deriving Show + +instance FromJSON SongType where + parseJSON (String "youtube") = return SongTypeYoutube + parseJSON (String "soundcloud") = return SongTypeSoundcloud + parseJSON invalid = typeMismatch "SongType" invalid + +data Song = Song { songId :: T.Text + , songType :: SongType + , songFkId :: T.Text + , songName :: T.Text + } deriving Show + +instance FromJSON Song where + parseJSON (Object v) = Song + <$> v .: "songid" + <*> v .: "type" + <*> v .: "fkid" + <*> v .: "name" + parseJSON invalid = typeMismatch "Song" invalid + +data Room = Room { roomCurrentSong :: Maybe Song } deriving Show + +instance FromJSON Room where + parseJSON (Object v) = Room <$> v .: "currentSong" + parseJSON invalid = typeMismatch "Room" invalid + +data DubtrackResponse a = + DubtrackResponse { drCode :: Int + , drMessage :: T.Text + , drData :: a + } + +instance FromJSON a => FromJSON (DubtrackResponse a) where + parseJSON (Object v) = DubtrackResponse + <$> v .: "code" + <*> v .: "message" + <*> v .: "data" + parseJSON invalid = typeMismatch "DubtrackResponse" invalid + +currentSong :: Effect T.Text +currentSong = undefined + +currentSongCommand :: CommandHandler () +currentSongCommand sender _ = + do request <- parseRequest "https://api.dubtrack.fm/room/tsoding" + response <- eitherDecode . getResponseBody + <$> httpRequest request + case response of + Left message -> errorEff $ T.pack message + Right dubtrackResponse -> + maybe (replyToSender sender "Nothing is playing right now") + (replyToSender sender . songName) + (roomCurrentSong $ drData dubtrackResponse) From 569ddbb03589a9d9ba558345f8b5937de438fa05 Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 24 Aug 2018 00:46:05 +0700 Subject: [PATCH 2/5] (#79) Provide link on !song --- src/Bot/Dubtrack.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Bot/Dubtrack.hs b/src/Bot/Dubtrack.hs index 87177fb..94c06f1 100644 --- a/src/Bot/Dubtrack.hs +++ b/src/Bot/Dubtrack.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} module Bot.Dubtrack where import Bot.Replies @@ -8,6 +9,7 @@ import Data.Aeson.Types import qualified Data.Text as T import Effect import Network.HTTP.Simple +import Text.Printf data SongType = SongTypeYoutube | SongTypeSoundcloud @@ -51,11 +53,17 @@ instance FromJSON a => FromJSON (DubtrackResponse a) where <*> v .: "data" parseJSON invalid = typeMismatch "DubtrackResponse" invalid -currentSong :: Effect T.Text -currentSong = undefined +songLink :: Song -> T.Text +songLink song@(songType -> SongTypeYoutube) = + T.pack $ printf "https://www.youtube.com/watch?v=%s" $ songFkId song +-- TODO: Soundcloud links are not supported yet +songLink (songType -> SongTypeSoundcloud) = + "Soundcloud links are not supported yet" +songLink _ = error "This should never happen Kappa" currentSongCommand :: CommandHandler () currentSongCommand sender _ = + -- TODO: Dubtrack room is hardcode do request <- parseRequest "https://api.dubtrack.fm/room/tsoding" response <- eitherDecode . getResponseBody <$> httpRequest request @@ -63,5 +71,5 @@ currentSongCommand sender _ = Left message -> errorEff $ T.pack message Right dubtrackResponse -> maybe (replyToSender sender "Nothing is playing right now") - (replyToSender sender . songName) + (\song -> replyToSender sender $ T.pack $ printf "%s: %s" (songName song) (songLink song)) (roomCurrentSong $ drData dubtrackResponse) From 85121936635d8694cb93a79f54221b61021f771b Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 24 Aug 2018 00:47:39 +0700 Subject: [PATCH 3/5] TODO(#220) --- src/Bot/Dubtrack.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot/Dubtrack.hs b/src/Bot/Dubtrack.hs index 94c06f1..1538ce9 100644 --- a/src/Bot/Dubtrack.hs +++ b/src/Bot/Dubtrack.hs @@ -56,7 +56,7 @@ instance FromJSON a => FromJSON (DubtrackResponse a) where songLink :: Song -> T.Text songLink song@(songType -> SongTypeYoutube) = T.pack $ printf "https://www.youtube.com/watch?v=%s" $ songFkId song --- TODO: Soundcloud links are not supported yet +-- TODO(#220): Soundcloud links are not supported yet songLink (songType -> SongTypeSoundcloud) = "Soundcloud links are not supported yet" songLink _ = error "This should never happen Kappa" From 90bc324f171c929072599e389c82762f10b8462d Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 24 Aug 2018 00:48:05 +0700 Subject: [PATCH 4/5] TODO(#221) --- src/Bot/Dubtrack.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Bot/Dubtrack.hs b/src/Bot/Dubtrack.hs index 1538ce9..00a4510 100644 --- a/src/Bot/Dubtrack.hs +++ b/src/Bot/Dubtrack.hs @@ -63,7 +63,7 @@ songLink _ = error "This should never happen Kappa" currentSongCommand :: CommandHandler () currentSongCommand sender _ = - -- TODO: Dubtrack room is hardcode + -- TODO(#221): Dubtrack room is hardcode do request <- parseRequest "https://api.dubtrack.fm/room/tsoding" response <- eitherDecode . getResponseBody <$> httpRequest request From 2b4dc01c96e1291370a240561f44d258073a4d3c Mon Sep 17 00:00:00 2001 From: rexim Date: Fri, 24 Aug 2018 00:51:57 +0700 Subject: [PATCH 5/5] (#79) Fix hlint remarks --- src/Bot.hs | 2 +- src/Bot/Dubtrack.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Bot.hs b/src/Bot.hs index db677e5..d12d024 100644 --- a/src/Bot.hs +++ b/src/Bot.hs @@ -67,7 +67,7 @@ builtinCommands = $ regexArgsCommand "([a-zA-Z0-9]+) ?(.*)" $ pairArgsCommand $ updateCustomCommand builtinCommands)) - , ("song", ("Print currently playing song", noArgsCommand $ currentSongCommand)) + , ("song", ("Print currently playing song", noArgsCommand currentSongCommand)) ] noArgsCommand :: CommandHandler () -> CommandHandler a diff --git a/src/Bot/Dubtrack.hs b/src/Bot/Dubtrack.hs index 00a4510..e43fe7f 100644 --- a/src/Bot/Dubtrack.hs +++ b/src/Bot/Dubtrack.hs @@ -34,7 +34,7 @@ instance FromJSON Song where <*> v .: "name" parseJSON invalid = typeMismatch "Song" invalid -data Room = Room { roomCurrentSong :: Maybe Song } deriving Show +newtype Room = Room { roomCurrentSong :: Maybe Song } deriving Show instance FromJSON Room where parseJSON (Object v) = Room <$> v .: "currentSong"