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

-- | Metadata for a TV Episode.
--
--   * The 'episodeStillPath' field is an incomplete URL.  To
--     construct a complete URL you'll need to use the 'Configuration'
--     type and the 'episodeStillURLs' helper function.
data Episode = Episode
  { -- | TheMovieDB unique ID.
    Episode -> ItemID
episodeID :: ItemID,
    -- | Episode sequence number.
    Episode -> ItemID
episodeNumber :: Int,
    -- | Episode name.
    Episode -> Text
episodeName :: Text,
    -- | Short description of the episode.
    Episode -> Text
episodeOverview :: Text,
    -- | The season this episode belongs to.
    Episode -> ItemID
episodeSeasonNumber :: Int,
    -- | Episode air date, if it ever aired.
    Episode -> Maybe Day
episodeAirDate :: Maybe Day,
    -- | Incomplete URL to a still image from the episode.  See the
    -- 'episodeStillURLs' function for more information.
    Episode -> Text
episodeStillPath :: Text
  }
  deriving (Episode -> Episode -> Bool
(Episode -> Episode -> Bool)
-> (Episode -> Episode -> Bool) -> Eq Episode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Episode -> Episode -> Bool
$c/= :: Episode -> Episode -> Bool
== :: Episode -> Episode -> Bool
$c== :: Episode -> Episode -> Bool
Eq, ItemID -> Episode -> ShowS
[Episode] -> ShowS
Episode -> String
(ItemID -> Episode -> ShowS)
-> (Episode -> String) -> ([Episode] -> ShowS) -> Show Episode
forall a.
(ItemID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Episode] -> ShowS
$cshowList :: [Episode] -> ShowS
show :: Episode -> String
$cshow :: Episode -> String
showsPrec :: ItemID -> Episode -> ShowS
$cshowsPrec :: ItemID -> Episode -> ShowS
Show)

instance Ord Episode where
  compare :: Episode -> Episode -> Ordering
compare Episode
a Episode
b =
    (ItemID, ItemID) -> (ItemID, ItemID) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
      (Episode -> ItemID
episodeSeasonNumber Episode
a, Episode -> ItemID
episodeNumber Episode
a)
      (Episode -> ItemID
episodeSeasonNumber Episode
b, Episode -> ItemID
episodeNumber Episode
b)

instance FromJSON Episode where
  parseJSON :: Value -> Parser Episode
parseJSON = String -> (Object -> Parser Episode) -> Value -> Parser Episode
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Episode" ((Object -> Parser Episode) -> Value -> Parser Episode)
-> (Object -> Parser Episode) -> Value -> Parser Episode
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ItemID
-> ItemID -> Text -> Text -> ItemID -> Maybe Day -> Text -> Episode
Episode (ItemID
 -> ItemID
 -> Text
 -> Text
 -> ItemID
 -> Maybe Day
 -> Text
 -> Episode)
-> Parser ItemID
-> Parser
     (ItemID -> Text -> Text -> ItemID -> Maybe Day -> Text -> Episode)
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 -> Text -> Text -> ItemID -> Maybe Day -> Text -> Episode)
-> Parser ItemID
-> Parser (Text -> Text -> ItemID -> Maybe Day -> Text -> Episode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser ItemID
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"episode_number"
      Parser (Text -> Text -> ItemID -> Maybe Day -> Text -> Episode)
-> Parser Text
-> Parser (Text -> ItemID -> Maybe Day -> Text -> Episode)
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 -> ItemID -> Maybe Day -> Text -> Episode)
-> Parser Text -> Parser (ItemID -> Maybe Day -> Text -> Episode)
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
"overview"
      Parser (ItemID -> Maybe Day -> Text -> Episode)
-> Parser ItemID -> Parser (Maybe Day -> Text -> Episode)
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 -> Text -> Episode)
-> Parser (Maybe Day) -> Parser (Text -> Episode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Day)
.:: Text
"air_date"
      Parser (Text -> Episode) -> Parser Text -> Parser Episode
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
"still_path" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""

-- | Return a list of URLs for all possible episode still images.
episodeStillURLs :: Configuration -> Episode -> [Text]
episodeStillURLs :: Configuration -> Episode -> [Text]
episodeStillURLs Configuration
c Episode
e = Configuration -> Text -> [Text]
posterURLs Configuration
c (Episode -> Text
episodeStillPath Episode
e)