-- |
--
-- 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.Internal.Settings
  ( Settings (..),
    defaultSettings,
  )
where

import Data.Aeson
import Network.API.TheMovieDB.Internal.Types

-- | Settings used by this library.
data Settings = Settings
  { -- | The API key to use.
    Settings -> Key
tmdbKey :: Key,
    -- | Optional ISO 639-1 language code to send with every request.
    Settings -> Maybe Key
tmdbLanguage :: Maybe LanguageCode
  }

instance FromJSON Settings where
  parseJSON :: Value -> Parser Settings
parseJSON = String -> (Object -> Parser Settings) -> Value -> Parser Settings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Settings" ((Object -> Parser Settings) -> Value -> Parser Settings)
-> (Object -> Parser Settings) -> Value -> Parser Settings
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    Key -> Maybe Key -> Settings
Settings
      (Key -> Maybe Key -> Settings)
-> Parser Key -> Parser (Maybe Key -> Settings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Key
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
      Parser (Maybe Key -> Settings)
-> Parser (Maybe Key) -> Parser Settings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Key)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lang"

instance ToJSON Settings where
  toJSON :: Settings -> Value
toJSON Settings {Maybe Key
Key
tmdbLanguage :: Maybe Key
tmdbKey :: Key
tmdbLanguage :: Settings -> Maybe Key
tmdbKey :: Settings -> Key
..} =
    [Pair] -> Value
object
      [ Key
"key" Key -> Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Key
tmdbKey,
        Key
"lang" Key -> Maybe Key -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Key
tmdbLanguage
      ]

-- | Default settings.
defaultSettings :: Key -> Settings
defaultSettings :: Key -> Settings
defaultSettings Key
key =
  Settings :: Key -> Maybe Key -> Settings
Settings
    { tmdbKey :: Key
tmdbKey = Key
key,
      tmdbLanguage :: Maybe Key
tmdbLanguage = Maybe Key
forall a. Maybe a
Nothing
    }