-- |
--
-- 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.Season
  ( Season (..),
    seasonPosterURLs,
  )
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.Episode

-- | Metadata for a TV Season.
--
--   * The 'seasonPosterPath' field is an incomplete URL.  To
--     construct a complete URL you'll need to use the 'Configuration'
--     type and the 'seasonPosterURLs' helper function.
data Season = Season
  { -- | TheMovieDB unique ID.
    Season -> ItemID
seasonID :: ItemID,
    -- | Season sequence number.  Remember that season 0 is sometimes
    -- used to hold unreleased/unaired episodes.
    Season -> ItemID
seasonNumber :: Int,
    -- | The date this season began to air, if ever.
    Season -> Maybe Day
seasonAirDate :: Maybe Day,
    -- | Number of episodes in this season.
    Season -> ItemID
seasonEpisodeCount :: Int,
    -- | Incomplete URL for poster image.  See 'seasonPosterURLs'.
    Season -> Text
seasonPosterPath :: Text,
    -- | List of 'Episode's.
    Season -> [Episode]
seasonEpisodes :: [Episode]
  }
  deriving (Season -> Season -> Bool
(Season -> Season -> Bool)
-> (Season -> Season -> Bool) -> Eq Season
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Season -> Season -> Bool
$c/= :: Season -> Season -> Bool
== :: Season -> Season -> Bool
$c== :: Season -> Season -> Bool
Eq, ItemID -> Season -> ShowS
[Season] -> ShowS
Season -> String
(ItemID -> Season -> ShowS)
-> (Season -> String) -> ([Season] -> ShowS) -> Show Season
forall a.
(ItemID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Season] -> ShowS
$cshowList :: [Season] -> ShowS
show :: Season -> String
$cshow :: Season -> String
showsPrec :: ItemID -> Season -> ShowS
$cshowsPrec :: ItemID -> Season -> ShowS
Show)

instance Ord Season where
  compare :: Season -> Season -> Ordering
compare Season
a Season
b = Season -> ItemID
seasonNumber Season
a ItemID -> ItemID -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Season -> ItemID
seasonNumber Season
b

instance FromJSON Season where
  parseJSON :: Value -> Parser Season
parseJSON = String -> (Object -> Parser Season) -> Value -> Parser Season
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Season" ((Object -> Parser Season) -> Value -> Parser Season)
-> (Object -> Parser Season) -> Value -> Parser Season
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ItemID
-> ItemID -> Maybe Day -> ItemID -> Text -> [Episode] -> Season
Season
      (ItemID
 -> ItemID -> Maybe Day -> ItemID -> Text -> [Episode] -> Season)
-> Parser ItemID
-> Parser
     (ItemID -> Maybe Day -> ItemID -> Text -> [Episode] -> Season)
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
  (ItemID -> Maybe Day -> ItemID -> Text -> [Episode] -> Season)
-> Parser ItemID
-> Parser (Maybe Day -> ItemID -> Text -> [Episode] -> Season)
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 a
.: Text
"season_number" Parser (Maybe ItemID) -> ItemID -> Parser ItemID
forall a. Parser (Maybe a) -> a -> Parser a
.!= ItemID
0
      Parser (Maybe Day -> ItemID -> Text -> [Episode] -> Season)
-> Parser (Maybe Day)
-> Parser (ItemID -> Text -> [Episode] -> Season)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Day)
.:: Text
"air_date"
      Parser (ItemID -> Text -> [Episode] -> Season)
-> Parser ItemID -> Parser (Text -> [Episode] -> Season)
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
"episode_count" Parser (Maybe ItemID) -> ItemID -> Parser ItemID
forall a. Parser (Maybe a) -> a -> Parser a
.!= ItemID
0
      Parser (Text -> [Episode] -> Season)
-> Parser Text -> Parser ([Episode] -> Season)
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 a
.: Text
"poster_path" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Parser ([Episode] -> Season) -> Parser [Episode] -> Parser Season
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Episode])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"episodes" Parser (Maybe [Episode]) -> [Episode] -> Parser [Episode]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Return a list of URLs for all possible season posters.
seasonPosterURLs :: Configuration -> Season -> [Text]
seasonPosterURLs :: Configuration -> Season -> [Text]
seasonPosterURLs Configuration
c Season
s = Configuration -> Text -> [Text]
posterURLs Configuration
c (Season -> Text
seasonPosterPath Season
s)