-- |
--
-- Copyright:
--   This file is part of the package themoviedb.  It is subject to
--   the license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/themoviedb
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: MIT
module Network.API.TheMovieDB.Types.TV
  ( TV (..),
    tvPosterURLs,
  )
where

import Data.Aeson
import Data.Time (Day (..))
import Network.API.TheMovieDB.Internal.Configuration
import Network.API.TheMovieDB.Internal.Date
import Network.API.TheMovieDB.Internal.Types
import Network.API.TheMovieDB.Types.Genre
import Network.API.TheMovieDB.Types.Season

-- | Metadata for a TV series.
--
--   * The 'tvPosterPath' field is an incomplete URL.  To construct a
--     complete URL you'll need to use the 'Configuration' type and the
--    'tvPosterURLs' helper function.
data TV = TV
  { -- | TheMovieDB unique ID.
    TV -> ItemID
tvID :: ItemID,
    -- | The name of the TV series.
    TV -> Text
tvName :: Text,
    -- | Short description of the TV series.
    TV -> Text
tvOverview :: Text,
    -- | List of 'Genre's.
    TV -> [Genre]
tvGenres :: [Genre],
    -- | Popularity ranking.
    TV -> Double
tvPopularity :: Double,
    -- | Incomplete URL for poster image.  See 'tvPosterURLs'.
    TV -> Text
tvPosterPath :: Text,
    -- | Air date for first episode.
    TV -> Maybe Day
tvFirstAirDate :: Maybe Day,
    -- | Air date for last episode.
    TV -> Maybe Day
tvLastAirDate :: Maybe Day,
    -- | Number of seasons for the TV series.
    TV -> ItemID
tvNumberOfSeasons :: Int,
    -- | Total number of episodes for all seasons.
    TV -> ItemID
tvNumberOfEpisodes :: Int,
    -- | Information about each season.
    --
    -- The number of elements in this list may not match
    -- 'tvNumberOfSeasons'.  Information about special episodes and
    -- unreleased episodes are usually kept in a 'Season' listed as
    -- season 0.  Therefore, the first element in this list might not
    -- be season 1.
    TV -> [Season]
tvSeasons :: [Season]
  }
  deriving (TV -> TV -> Bool
(TV -> TV -> Bool) -> (TV -> TV -> Bool) -> Eq TV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TV -> TV -> Bool
$c/= :: TV -> TV -> Bool
== :: TV -> TV -> Bool
$c== :: TV -> TV -> Bool
Eq, ItemID -> TV -> ShowS
[TV] -> ShowS
TV -> String
(ItemID -> TV -> ShowS)
-> (TV -> String) -> ([TV] -> ShowS) -> Show TV
forall a.
(ItemID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TV] -> ShowS
$cshowList :: [TV] -> ShowS
show :: TV -> String
$cshow :: TV -> String
showsPrec :: ItemID -> TV -> ShowS
$cshowsPrec :: ItemID -> TV -> ShowS
Show)

instance Ord TV where
  compare :: TV -> TV -> Ordering
compare TV
a TV
b = TV -> ItemID
tvID TV
a ItemID -> ItemID -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` TV -> ItemID
tvID TV
b

instance FromJSON TV where
  parseJSON :: Value -> Parser TV
parseJSON = String -> (Object -> Parser TV) -> Value -> Parser TV
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TV" ((Object -> Parser TV) -> Value -> Parser TV)
-> (Object -> Parser TV) -> Value -> Parser TV
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ItemID
-> Text
-> Text
-> [Genre]
-> Double
-> Text
-> Maybe Day
-> Maybe Day
-> ItemID
-> ItemID
-> [Season]
-> TV
TV
      (ItemID
 -> Text
 -> Text
 -> [Genre]
 -> Double
 -> Text
 -> Maybe Day
 -> Maybe Day
 -> ItemID
 -> ItemID
 -> [Season]
 -> TV)
-> Parser ItemID
-> Parser
     (Text
      -> Text
      -> [Genre]
      -> Double
      -> Text
      -> Maybe Day
      -> Maybe Day
      -> ItemID
      -> ItemID
      -> [Season]
      -> TV)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser ItemID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
      Parser
  (Text
   -> Text
   -> [Genre]
   -> Double
   -> Text
   -> Maybe Day
   -> Maybe Day
   -> ItemID
   -> ItemID
   -> [Season]
   -> TV)
-> Parser Text
-> Parser
     (Text
      -> [Genre]
      -> Double
      -> Text
      -> Maybe Day
      -> Maybe Day
      -> ItemID
      -> ItemID
      -> [Season]
      -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"
      Parser
  (Text
   -> [Genre]
   -> Double
   -> Text
   -> Maybe Day
   -> Maybe Day
   -> ItemID
   -> ItemID
   -> [Season]
   -> TV)
-> Parser Text
-> Parser
     ([Genre]
      -> Double
      -> Text
      -> Maybe Day
      -> Maybe Day
      -> ItemID
      -> ItemID
      -> [Season]
      -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"overview" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Parser
  ([Genre]
   -> Double
   -> Text
   -> Maybe Day
   -> Maybe Day
   -> ItemID
   -> ItemID
   -> [Season]
   -> TV)
-> Parser [Genre]
-> Parser
     (Double
      -> Text
      -> Maybe Day
      -> Maybe Day
      -> ItemID
      -> ItemID
      -> [Season]
      -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Genre])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"genres" Parser (Maybe [Genre]) -> [Genre] -> Parser [Genre]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  (Double
   -> Text
   -> Maybe Day
   -> Maybe Day
   -> ItemID
   -> ItemID
   -> [Season]
   -> TV)
-> Parser Double
-> Parser
     (Text
      -> Maybe Day -> Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"popularity" Parser (Maybe Double) -> Double -> Parser Double
forall a. Parser (Maybe a) -> a -> Parser a
.!= Double
0.0
      Parser
  (Text
   -> Maybe Day -> Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
-> Parser Text
-> Parser
     (Maybe Day -> Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"poster_path" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Parser
  (Maybe Day -> Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
-> Parser (Maybe Day)
-> Parser (Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Day)
.:: Text
"first_air_date"
      Parser (Maybe Day -> ItemID -> ItemID -> [Season] -> TV)
-> Parser (Maybe Day)
-> Parser (ItemID -> ItemID -> [Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Day)
.:: Text
"last_air_date"
      Parser (ItemID -> ItemID -> [Season] -> TV)
-> Parser ItemID -> Parser (ItemID -> [Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe ItemID)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"number_of_seasons" Parser (Maybe ItemID) -> ItemID -> Parser ItemID
forall a. Parser (Maybe a) -> a -> Parser a
.!= ItemID
0
      Parser (ItemID -> [Season] -> TV)
-> Parser ItemID -> Parser ([Season] -> TV)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe ItemID)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"number_of_episodes" Parser (Maybe ItemID) -> ItemID -> Parser ItemID
forall a. Parser (Maybe a) -> a -> Parser a
.!= ItemID
0
      Parser ([Season] -> TV) -> Parser [Season] -> Parser TV
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Season])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"seasons" Parser (Maybe [Season]) -> [Season] -> Parser [Season]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Return a list of URLs for all possible TV posters.
tvPosterURLs :: Configuration -> TV -> [Text]
tvPosterURLs :: Configuration -> TV -> [Text]
tvPosterURLs Configuration
c TV
m = Configuration -> Text -> [Text]
posterURLs Configuration
c (TV -> Text
tvPosterPath TV
m)