{-# LANGUAGE OverloadedStrings #-}
module Network.Radio.BronyRadioGermany.URI where

import Data.Text
import Data.Monoid
import Data.Time.Clock
import Data.Time.Zones
import Data.Time.Zones.All
import Data.Time.Format
import Network.Radio.BronyRadioGermany.Types
import Network.URI
import Data.UUID.Types

-- | BronyRadioGermany API base URI
brgPanelBaseURI :: Text
brgPanelBaseURI = "https://panel.bronyradiogermany.com/"

-- | URI of the given radio stream
brgStreamURI :: Mountpoint -> Text
brgStreamURI MainDJ = "http://radio.bronyradiogermany.com:8000/stream"
brgStreamURI MainDJMobile = "http://radio.bronyradiogermany.com:8000/mobile"
brgStreamURI MainDJOpus = "http://radio.bronyradiogermany.com:8000/opus"
brgStreamURI DayDJ = "http://radio.bronyradiogermany.com:8006/daydj"
brgStreamURI NightDJ = "http://radio.bronyradiogermany.com:8003/nightdj"

-- | URI for StreamInfo requests (GET)
brgStreamInfoURI :: Mountpoint -> Text
brgStreamInfoURI mp = brgPanelBaseURI <> "/api/streaminfo/" <> pack (show mp)

-- | URI for TrackInfo requests (GET)
brgTrackInfoURI :: HasTrackId t => t -> Text
brgTrackInfoURI t = brgPanelBaseURI <> "/api/track/" <> pack (show (trackId t))

-- | URI for AutoDJ track list requests (GET)
brgTrackListURI :: Maybe Text -> Maybe Text -> Text
brgTrackListURI Nothing Nothing = brgPanelBaseURI <> "/api/autodj/track/list"
brgTrackListURI mtitle martist =
  brgPanelBaseURI <> "/api/autodj/track/list?" <> title <> conn <> artist
  where conn | Just _ <- mtitle, Just _ <- martist = "&"
             | otherwise = ""
        title | Just t <- mtitle = "title=" <> pack (escapeURIString isUnescapedInURIComponent $ unpack t)
              | otherwise = ""
        artist | Just a <- martist = "artist=" <> pack (escapeURIString isUnescapedInURIComponent $ unpack a)
               | otherwise = ""

-- | URI for history list requests (GET)
brgHistoryURI :: Int -> Maybe UTCTime -> Maybe UTCTime -> Maybe Text -> Maybe Text -> Text
brgHistoryURI page mstart mend mtitle martist =
  brgPanelBaseURI <> "/api/history/" <> pack (show page) <> "?"
  <> title <> artist
  where title | Just t <- mtitle = "title=" <> pack (escapeURIString isUnescapedInURIComponent $ unpack t) <> "&"
              | otherwise = ""
        artist | Just a <- martist = "artist=" <> pack (escapeURIString isUnescapedInURIComponent $ unpack a) <> "&"
               | otherwise = ""
        mstartCET = utcToLocalTimeTZ (tzByLabel Europe__Berlin) <$> mstart
        mendCET = utcToLocalTimeTZ (tzByLabel Europe__Berlin) <$> mend
        datePlayedStart | Just t <- mstartCET = "date_played_start=" <> pack (formatTime defaultTimeLocale "%F" t) <> "&"
                        | otherwise = ""
        datePlayedEnd | Just t <- mendCET = "date_played_end=" <> pack (formatTime defaultTimeLocale "%F" t) <> "&"
                      | otherwise = ""
        timePlayedStart | Just t <- mstartCET = "time_played_start=" <> pack (formatTime defaultTimeLocale "%T" t) <> "&"
                        | otherwise = ""
        timePlayedEnd | Just t <- mendCET = "time_played_end=" <> pack (formatTime defaultTimeLocale "%F" t) <> "&"
                      | otherwise = ""

-- | URI for up votes (GET)
brgUpVoteURI :: UUID -> Mountpoint -> Text
brgUpVoteURI uuid mp = "https://www.bronyradiogermany.com/request-v2/json/v1/vote/song/" <> toText uuid <> "/up/" <> pack (show mp)

-- | URI for down votes (GET)
brgDownVoteURI :: UUID -> Mountpoint -> Text
brgDownVoteURI uuid mp = "https://www.bronyradiogermany.com/request-v2/json/v1/vote/song/" <> toText uuid <> "/down/" <> pack (show mp)

-- | URI for checking if the UUID has already voted (GET)
brgVoteCheckURI :: UUID -> Mountpoint -> Text
brgVoteCheckURI uuid mp = brgPanelBaseURI <> "/api/vote/check/" <> toText uuid <> "/" <> pack (show mp)

-- | URI for requesting a song (POST, params: title, artist, nickname)
brgAutoDJRequestURI :: Text
brgAutoDJRequestURI = "https://www.bronyradiogermany.com/request-v2/action/add_request_autodj.php"

-- | POST body for requesting a song
brgAutoDJRequestBody :: Text -> Text -> Text -> String
brgAutoDJRequestBody nick title artist =
  "title=" <> (escapeURIString isUnescapedInURIComponent $ unpack title)
  <> "&artist=" <> (escapeURIString isUnescapedInURIComponent $ unpack artist)
  <> "&nickname=" <> (escapeURIString isUnescapedInURIComponent $ unpack nick)
  <> "\n"