{-# 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)]