-- |
--
-- 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.Movie
  ( Movie (..),
    moviePosterURLs,
  )
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

-- | Metadata for a movie.
--
--   * The 'moviePosterPath' field is an incomplete URL.  To construct
--     a complete URL you'll need to use the 'Configuration' type and
--     the 'moviePosterURLs' helper function.
data Movie = Movie
  { -- | TheMovieDB unique ID.
    Movie -> ItemID
movieID :: ItemID,
    -- | The name/title of the movie.
    Movie -> Text
movieTitle :: Text,
    -- | Short plot summary.
    Movie -> Text
movieOverview :: Text,
    -- | List of 'Genre's.
    Movie -> [Genre]
movieGenres :: [Genre],
    -- | Popularity ranking.
    Movie -> Double
moviePopularity :: Double,
    -- | Incomplete URL for poster image.  See 'moviePosterURLs'.
    Movie -> Text
moviePosterPath :: Text,
    -- | Movie release date.  (Movie may not have been released yet.)
    Movie -> Maybe Day
movieReleaseDate :: Maybe Day,
    -- | TheMovieDB adult movie flag.
    Movie -> Bool
movieAdult :: Bool,
    -- | IMDB.com ID.
    Movie -> Text
movieIMDB :: Text,
    -- | Movie length in minutes.
    Movie -> ItemID
movieRunTime :: Int
  }
  deriving (Movie -> Movie -> Bool
(Movie -> Movie -> Bool) -> (Movie -> Movie -> Bool) -> Eq Movie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Movie -> Movie -> Bool
$c/= :: Movie -> Movie -> Bool
== :: Movie -> Movie -> Bool
$c== :: Movie -> Movie -> Bool
Eq, ItemID -> Movie -> ShowS
[Movie] -> ShowS
Movie -> String
(ItemID -> Movie -> ShowS)
-> (Movie -> String) -> ([Movie] -> ShowS) -> Show Movie
forall a.
(ItemID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Movie] -> ShowS
$cshowList :: [Movie] -> ShowS
show :: Movie -> String
$cshow :: Movie -> String
showsPrec :: ItemID -> Movie -> ShowS
$cshowsPrec :: ItemID -> Movie -> ShowS
Show)

instance FromJSON Movie where
  parseJSON :: Value -> Parser Movie
parseJSON = String -> (Object -> Parser Movie) -> Value -> Parser Movie
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Movie" ((Object -> Parser Movie) -> Value -> Parser Movie)
-> (Object -> Parser Movie) -> Value -> Parser Movie
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ItemID
-> Text
-> Text
-> [Genre]
-> Double
-> Text
-> Maybe Day
-> Bool
-> Text
-> ItemID
-> Movie
Movie
      (ItemID
 -> Text
 -> Text
 -> [Genre]
 -> Double
 -> Text
 -> Maybe Day
 -> Bool
 -> Text
 -> ItemID
 -> Movie)
-> Parser ItemID
-> Parser
     (Text
      -> Text
      -> [Genre]
      -> Double
      -> Text
      -> Maybe Day
      -> Bool
      -> Text
      -> ItemID
      -> Movie)
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
   -> Bool
   -> Text
   -> ItemID
   -> Movie)
-> Parser Text
-> Parser
     (Text
      -> [Genre]
      -> Double
      -> Text
      -> Maybe Day
      -> Bool
      -> Text
      -> ItemID
      -> Movie)
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
"title"
      Parser
  (Text
   -> [Genre]
   -> Double
   -> Text
   -> Maybe Day
   -> Bool
   -> Text
   -> ItemID
   -> Movie)
-> Parser Text
-> Parser
     ([Genre]
      -> Double -> Text -> Maybe Day -> Bool -> Text -> ItemID -> Movie)
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 -> Bool -> Text -> ItemID -> Movie)
-> Parser [Genre]
-> Parser
     (Double -> Text -> Maybe Day -> Bool -> Text -> ItemID -> Movie)
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 -> Bool -> Text -> ItemID -> Movie)
-> Parser Double
-> Parser (Text -> Maybe Day -> Bool -> Text -> ItemID -> Movie)
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 -> Bool -> Text -> ItemID -> Movie)
-> Parser Text
-> Parser (Maybe Day -> Bool -> Text -> ItemID -> Movie)
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 -> Bool -> Text -> ItemID -> Movie)
-> Parser (Maybe Day) -> Parser (Bool -> Text -> ItemID -> Movie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Day)
.:: Text
"release_date"
      Parser (Bool -> Text -> ItemID -> Movie)
-> Parser Bool -> Parser (Text -> ItemID -> Movie)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"adult" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
      Parser (Text -> ItemID -> Movie)
-> Parser Text -> Parser (ItemID -> Movie)
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
"imdb_id" Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      Parser (ItemID -> Movie) -> Parser ItemID -> Parser Movie
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
"runtime" Parser (Maybe ItemID) -> ItemID -> Parser ItemID
forall a. Parser (Maybe a) -> a -> Parser a
.!= ItemID
0

-- | Return a list of URLs for all possible movie posters.
moviePosterURLs :: Configuration -> Movie -> [Text]
moviePosterURLs :: Configuration -> Movie -> [Text]
moviePosterURLs Configuration
c Movie
m = Configuration -> Text -> [Text]
posterURLs Configuration
c (Movie -> Text
moviePosterPath Movie
m)