{-# LANGUAGE DeriveGeneric, OverloadedStrings, RecordWildCards #-} module Network.Radio.BronyRadioGermany.Types where import Data.Aeson import Data.Aeson.Encoding import Data.Aeson.Types import Data.Maybe import Data.Monoid import Data.Time.Clock import Data.Time.Calendar import Data.Time.Format import Data.Time.LocalTime import Data.Time.Zones import Data.Time.Zones.All import qualified Data.Text as T import Text.Read (readMaybe) -- | BRG provides three radio channels: the main channel, DayDJ and NightDJ. All channels are broadcasted in MPEG 4, 128kbps. For the main channel there is also an Opus stream with 96kbps and a mobile MPEG 4 stream with 64kbps. data Mountpoint = MainDJ | MainDJMobile | MainDJOpus | DayDJ | NightDJ deriving (Eq) instance Show Mountpoint where show MainDJ = "stream" show MainDJMobile = "mobile" show MainDJOpus = "opus" show DayDJ = "daydj" show NightDJ = "nightdj" instance Read Mountpoint where readsPrec d r = [(mp,t) | (mpstr,t) <- lex r, mp <- tomp mpstr] where tomp "stream" = [MainDJ] tomp "daydj" = [DayDJ] tomp "nightdj" = [NightDJ] tomp "mobile" = [MainDJMobile] tomp "opus" = [MainDJOpus] tomp _ = [] instance FromJSON Mountpoint where parseJSON (String t) = case readMaybe (T.unpack t) of Nothing -> fail ("Not a valid mount point: "++ show t) Just mp -> return mp parseJSON invalid = typeMismatch "Mountpoint" invalid instance ToJSON Mountpoint where toJSON mp = String (T.pack $ show mp) toEncoding mp = string (show mp) -- | A response may have succeeded or failed, and it may be chunked into several pages. data Response a = Successful { responseResult :: !a, responseNextPage :: Maybe T.Text, responsePreviousPage :: Maybe T.Text, responsePages :: Maybe Int } | Errorful !T.Text deriving (Eq, Show) instance FromJSON a => FromJSON (Response a) where parseJSON = withObject "Response" $ \o -> do statusmsg <- o .: "status" case statusmsg of String "success" -> do result <- parseJSON =<< o .: "result" Successful result <$> (o .:? "next_page") <*> (o .:? "previous_page") <*> (o .:? "pages") _ -> do message <- o .: "message" case message of String e -> return (Errorful e) _ -> fail "Invalid \"status\" or \"message\" in response" instance ToJSON a => ToJSON (Response a) where toJSON (Successful a mnp mpp mp) = object (["status" .= ("success" :: T.Text), "result" .= a] ++ maybe [] (\np -> ["next_page" .= np]) mnp ++ maybe [] (\pp -> ["previous_page" .= pp]) mpp ++ maybe [] (\p -> ["pages" .= p]) mp) toJSON (Errorful e) = object ["status" .= ("error" :: T.Text), "message" .= e] toEncoding (Successful a mnp mpp mp) = pairs $ mconcat (["status" .= ("success" :: T.Text), "result" .= a] ++ maybe [] (\np -> ["next_page" .= np]) mnp ++ maybe [] (\pp -> ["previous_page" .= pp]) mpp ++ maybe [] (\p -> ["pages" .= p]) mp) toEncoding (Errorful e) = pairs ("status" .= ("error" :: T.Text) <> "message" .= e) -- | Information on a specific Mountpoint data StreamInfo = StreamInfo { siListener :: !Int, -- ^ Current listeners siStatus :: !T.Text, -- ^ Current status (e.g. "online") siCurrentEvent :: !T.Text, -- ^ Current event ("DJ-Pony Lucy" for the AutoDJ) siTrackInfo :: !TrackInfo -- ^ Current song } deriving (Eq, Show) instance FromJSON StreamInfo where parseJSON = withObject "StreamInfo" $ \o -> StreamInfo <$> (o .: "listener") <*> (o .: "status") <*> (o .: "current_event") <*> parseJSON (Object o) instance ToJSON StreamInfo where toJSON si@StreamInfo{..} = object ["id" .= trackId si, "title" .= trackTitle si, "artist" .= trackArtist si, "listener" .= siListener, "status" .= siStatus, "current_event" .= siCurrentEvent, "upvotes" .= show (upVotes si), "downvotes" .= show (downVotes si)] toEncoding si@StreamInfo{..} = pairs $ mconcat ["id" .= trackId si, "title" .= trackTitle si, "artist" .= trackArtist si, "listener" .= siListener, "status" .= siStatus, "current_event" .= siCurrentEvent, "upvotes" .= show (upVotes si), "downvotes" .= show (downVotes si)] -- | Wider information on a specific track. data TrackInfo = TrackInfo { tiTrack :: !Track, -- ^ Core information (id, title, artist) tiUpVotes :: !Int, -- ^ Up votes tiDownVotes :: !Int -- ^ Down votes } deriving (Eq, Show) -- | Core information on a specific track. data Track = Track { trId :: !Int, -- ^ track id trTitle :: !T.Text, -- ^ track title trArtist :: !T.Text -- ^ track artist } deriving (Eq, Show) -- | Everything that contains a track id. class HasTrackId t where trackId :: t -> Int -- ^ Get the track id setTrackId :: Int -> t -> t -- ^ Change the track id instance HasTrackId Int where trackId = id setTrackId = const instance HasTrackId Track where trackId = trId setTrackId i tr = tr{trId=i} instance HasTrackId TrackInfo where trackId = trId . tiTrack setTrackId i ti = ti{tiTrack = setTrackId i (tiTrack ti)} instance HasTrackId StreamInfo where trackId = trackId . siTrackInfo setTrackId i si = si{siTrackInfo = setTrackId i (siTrackInfo si)} -- | Everything that contains core information about a track class HasTrackId t => HasTrack t where trackTitle :: t -> T.Text -- ^ Get the track title setTrackTitle :: T.Text -> t -> t -- ^ Change the track title trackArtist :: t -> T.Text -- ^ Get the track artist setTrackArtist :: T.Text -> t -> t -- ^ Change the track artist instance HasTrack Track where trackTitle = trTitle trackArtist = trArtist setTrackTitle t tr = tr{trTitle=t} setTrackArtist a tr = tr{trArtist=a} instance HasTrack TrackInfo where trackTitle = trTitle . tiTrack trackArtist = trArtist . tiTrack setTrackTitle t ti = ti{tiTrack = setTrackTitle t (tiTrack ti)} setTrackArtist a ti = ti{tiTrack = setTrackArtist a (tiTrack ti)} instance HasTrack StreamInfo where trackTitle = trackTitle . siTrackInfo trackArtist = trackArtist . siTrackInfo setTrackTitle t si = si{siTrackInfo = setTrackTitle t (siTrackInfo si)} setTrackArtist a si = si{siTrackInfo = setTrackArtist a (siTrackInfo si)} -- | Everything that contains wider information about a track class HasTrack t => HasTrackInfo t where upVotes :: t -> Int -- ^ Get the track's upvotes setUpVotes :: Int -> t -> t -- ^ Change the track's upvotes downVotes :: t -> Int -- ^ Get the track's downvotes setDownVotes :: Int -> t -> t -- ^ Change the track's downvotes voteDifference :: t -> Int voteDifference t = upVotes t - downVotes t instance HasTrackInfo TrackInfo where upVotes = tiUpVotes downVotes = tiDownVotes setUpVotes v ti = ti{tiUpVotes=v} setDownVotes v ti = ti{tiDownVotes=v} instance HasTrackInfo StreamInfo where upVotes = upVotes . siTrackInfo downVotes = downVotes . siTrackInfo setUpVotes v si = si{siTrackInfo = setUpVotes v (siTrackInfo si)} setDownVotes v si = si{siTrackInfo = setDownVotes v (siTrackInfo si)} instance FromJSON TrackInfo where parseJSON = withObject "TrackInfo" $ \o -> TrackInfo <$> parseJSON (Object o) <*> fmap read (o .: "upvotes") <*> fmap read (o .: "downvotes") instance FromJSON Track where parseJSON = withObject "Track" $ \o -> Track <$> (o .: "id") <*> (o .: "title") <*> (o .: "artist") instance ToJSON TrackInfo where toJSON ti = object ["id" .= trackId ti, "title" .= trackTitle ti, "artist" .= trackArtist ti, "upvotes" .= show (upVotes ti), "downvotes" .= show (downVotes ti)] toEncoding ti = pairs $ mconcat ["id" .= trackId ti, "title" .= trackTitle ti, "artist" .= trackArtist ti, "upvotes" .= show (upVotes ti), "downvotes" .= show (downVotes ti)] instance ToJSON Track where toJSON tr = object ["id" .= trackId tr, "title" .= trackTitle tr, "artist" .= trackArtist tr] toEncoding tr = pairs $ mconcat ["id" .= trackId tr, "title" .= trackTitle tr, "artist" .= trackArtist tr] -- | An item in the history stream. Contains a track and a timestamp (converted to UTC) data HistoryItem = HistoryItem { hiTrack :: !Track, hiPlayedAt :: !UTCTime } deriving (Eq, Show) instance HasTrackId HistoryItem where trackId = trackId . hiTrack setTrackId i hi = hi{hiTrack = setTrackId i (hiTrack hi)} instance HasTrack HistoryItem where trackTitle = trackTitle . hiTrack trackArtist = trackArtist . hiTrack setTrackTitle t hi = hi{hiTrack = setTrackTitle t (hiTrack hi)} setTrackArtist a hi = hi{hiTrack = setTrackArtist a (hiTrack hi)} instance FromJSON HistoryItem where parseJSON = withObject "HistoryItem" $ \o -> do track <- parseJSON (Object o) datePlayed <- o .: "date_played" timePlayed <- o .: "time_played" let tz = tzByLabel Europe__Berlin datePlayedM = parseTimeM True defaultTimeLocale "%F" datePlayed :: Maybe Day timePlayedM = parseTimeM True defaultTimeLocale "%T" timePlayed :: Maybe TimeOfDay localTimeM = LocalTime <$> datePlayedM <*> timePlayedM utcTimeM = localTimeToUTCTZ tz <$> localTimeM case utcTimeM of Nothing -> fail "Time/date parsing failed" Just time -> return $ HistoryItem track time instance ToJSON HistoryItem where toJSON hi = object ["id" .= trackId hi, "title" .= trackTitle hi, "artist" .= trackArtist hi, "time_played" .= formatTime defaultTimeLocale "%T" localTime, "date_played" .= formatTime defaultTimeLocale "%F" localTime] where localTime = utcToLocalTimeTZ (tzByLabel Europe__Berlin) (hiPlayedAt hi) toEncoding hi = pairs $ mconcat ["id" .= trackId hi, "title" .= trackTitle hi, "artist" .= trackArtist hi, "time_played" .= formatTime defaultTimeLocale "%T" localTime, "date_played" .= formatTime defaultTimeLocale "%F" localTime] where localTime = utcToLocalTimeTZ (tzByLabel Europe__Berlin) (hiPlayedAt hi) -- | The vote status. Have you already voted for this song? Up or down? data VoteCheckResult = VoteCheckResult { vcVoted :: Bool, vcDirection :: T.Text } deriving (Eq,Show) instance FromJSON VoteCheckResult where parseJSON = withObject "VoteCheckResult" $ \o -> VoteCheckResult <$> (>>= itob) (o .: "voted") <*> (o .: "direction") where itob :: Monad m => Int -> m Bool itob 0 = return False itob 1 = return True itob i = fail (show i<>" is not a boolean value") instance ToJSON VoteCheckResult where toJSON vc = object ["voted" .= if vcVoted vc then 1 :: Int else 0, "direction" .= vcDirection vc] toEncoding vc = pairs $ mconcat ["voted" .= if vcVoted vc then 1 :: Int else 0, "direction" .= vcDirection vc] -- | The result of posting your vote. data VoteResult = VoteResult { vrVoted :: Bool, vrUpVotes :: Int, vrDownVotes :: Int } deriving (Eq, Show) instance FromJSON VoteResult where parseJSON = withObject "VoteResult" $ \o -> VoteResult <$> (o .: "voted") <*> strint (o .: "upvotes") <*> strint (o .: "downvotes") where strint :: Functor f => f String -> f Int strint = fmap read instance ToJSON VoteResult where toJSON vr = object ["voted" .= vrVoted vr, "upvotes" .= show (vrUpVotes vr), "downvotes" .= show (vrDownVotes vr)] toEncoding vr = pairs $ mconcat ["voted" .= vrVoted vr, "upvotes" .= show (vrUpVotes vr), "downvotes" .= show (vrDownVotes vr)]