-- |
--
-- 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
--
-- Internal configuration information for TheMovieDB API.
module Network.API.TheMovieDB.Internal.Configuration
  ( Configuration (..),
    posterURLs,
  )
where

import Data.Aeson

-- | TheMovieDB API tries to preserve bandwidth by omitting
-- information (such as full URLs for poster images) from most of the
-- API calls.  Therefore in order to construct a complete URL for a
-- movie poster you'll need to use the 'config' function to retrieve
-- API configuration information.
--
-- A helper function is provided ('moviePosterURLs') that constructs a
-- list of all poster URLs given a 'Movie' and 'Configuration'.
--
-- According to the API documentation for TheMovieDB, you should cache
-- the 'Configuration' value and only request it every few days.
data Configuration = Configuration
  { -- | The base URL for images.
    Configuration -> Text
cfgImageBaseURL :: Text,
    -- | Base URL for secure images.
    Configuration -> Text
cfgImageSecBaseURL :: Text,
    -- | List of possible image sizes.
    Configuration -> [Text]
cfgPosterSizes :: [Text]
  }
  deriving ((forall x. Configuration -> Rep Configuration x)
-> (forall x. Rep Configuration x -> Configuration)
-> Generic Configuration
forall x. Rep Configuration x -> Configuration
forall x. Configuration -> Rep Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Configuration x -> Configuration
$cfrom :: forall x. Configuration -> Rep Configuration x
Generic)

instance FromJSON Configuration where
  parseJSON :: Value -> Parser Configuration
parseJSON = String
-> (Object -> Parser Configuration)
-> Value
-> Parser Configuration
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Configuration" ((Object -> Parser Configuration) -> Value -> Parser Configuration)
-> (Object -> Parser Configuration)
-> Value
-> Parser Configuration
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Text -> Text -> [Text] -> Configuration
Configuration
      (Text -> Text -> [Text] -> Configuration)
-> Parser Text -> Parser (Text -> [Text] -> Configuration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Text -> Parser Text
forall b. FromJSON b => Object -> Text -> Parser b
images Object
v Text
"base_url"
      Parser (Text -> [Text] -> Configuration)
-> Parser Text -> Parser ([Text] -> Configuration)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Text -> Parser Text
forall b. FromJSON b => Object -> Text -> Parser b
images Object
v Text
"secure_base_url"
      Parser ([Text] -> Configuration)
-> Parser [Text] -> Parser Configuration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Text -> [Text] -> Parser [Text]
forall b. FromJSON b => Object -> Text -> b -> Parser b
imagesM Object
v Text
"poster_sizes" []
    where
      images :: Object -> Text -> Parser b
images Object
v Text
key = (Object
v Object -> Text -> Parser Object
forall b. FromJSON b => Object -> Text -> Parser b
.: Text
"images") Parser Object -> (Object -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> Text -> Parser b
forall b. FromJSON b => Object -> Text -> Parser b
.: Text
key)
      imagesM :: Object -> Text -> b -> Parser b
imagesM Object
v Text
key b
def = (Object
v Object -> Text -> Parser Object
forall b. FromJSON b => Object -> Text -> Parser b
.: Text
"images") Parser Object -> (Object -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Object
x -> Object
x Object -> Text -> Parser (Maybe b)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
key Parser (Maybe b) -> b -> Parser b
forall a. Parser (Maybe a) -> a -> Parser a
.!= b
def)

instance ToJSON Configuration where
  toJSON :: Configuration -> Value
toJSON Configuration
c =
    [Pair] -> Value
object
      [ Text
"images"
          Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
            [ Text
"base_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Configuration -> Text
cfgImageBaseURL Configuration
c,
              Text
"secure_base_url" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Configuration -> Text
cfgImageSecBaseURL Configuration
c,
              Text
"poster_sizes" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Configuration -> [Text]
cfgPosterSizes Configuration
c
            ]
      ]

-- | Return a list of URLs for all possible posters.
posterURLs :: Configuration -> Text -> [Text]
posterURLs :: Configuration -> Text -> [Text]
posterURLs Configuration
c Text
p = [Configuration -> Text
cfgImageBaseURL Configuration
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
size Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p | Text
size <- Configuration -> [Text]
cfgPosterSizes Configuration
c]