-- |
--
-- 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.Genre
  ( Genre (..),
  )
where

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

-- | Metadata for a genre.
data Genre = Genre
  { -- | TheMovieDB unique ID.
    Genre -> ItemID
genreID :: ItemID,
    -- | The name of the genre.
    Genre -> Text
genreName :: Text
  }
  deriving (Genre -> Genre -> Bool
(Genre -> Genre -> Bool) -> (Genre -> Genre -> Bool) -> Eq Genre
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Genre -> Genre -> Bool
$c/= :: Genre -> Genre -> Bool
== :: Genre -> Genre -> Bool
$c== :: Genre -> Genre -> Bool
Eq, ItemID -> Genre -> ShowS
[Genre] -> ShowS
Genre -> String
(ItemID -> Genre -> ShowS)
-> (Genre -> String) -> ([Genre] -> ShowS) -> Show Genre
forall a.
(ItemID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Genre] -> ShowS
$cshowList :: [Genre] -> ShowS
show :: Genre -> String
$cshow :: Genre -> String
showsPrec :: ItemID -> Genre -> ShowS
$cshowsPrec :: ItemID -> Genre -> ShowS
Show)

instance FromJSON Genre where
  parseJSON :: Value -> Parser Genre
parseJSON = String -> (Object -> Parser Genre) -> Value -> Parser Genre
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Genre" ((Object -> Parser Genre) -> Value -> Parser Genre)
-> (Object -> Parser Genre) -> Value -> Parser Genre
forall a b. (a -> b) -> a -> b
$ \Object
v ->
    ItemID -> Text -> Genre
Genre
      (ItemID -> Text -> Genre)
-> Parser ItemID -> Parser (Text -> Genre)
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 -> Genre) -> Parser Text -> Parser Genre
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"