-- |
--
-- 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.Actions
  ( searchMovies,
    fetchMovie,
    searchTV,
    fetchTV,
    fetchTVSeason,
    fetchFullTVSeries,
    config,
  )
where

import Network.API.TheMovieDB.Internal.Configuration
import Network.API.TheMovieDB.Internal.SearchResults
import Network.API.TheMovieDB.Internal.TheMovieDB
import Network.API.TheMovieDB.Internal.Types
import Network.API.TheMovieDB.Types.Movie
import Network.API.TheMovieDB.Types.Season
import Network.API.TheMovieDB.Types.TV

-- | Search TheMovieDB using the given query string.
--
-- The movies returned will not have all their fields completely
-- filled out, to get a complete record you'll need to follow this
-- call up with a call to 'fetchMovie'.
searchMovies :: Text -> TheMovieDB [Movie]
searchMovies :: Text -> TheMovieDB [Movie]
searchMovies Text
query = SearchResults Movie -> [Movie]
forall a. SearchResults a -> [a]
searchResults (SearchResults Movie -> [Movie])
-> TheMovieDB (SearchResults Movie) -> TheMovieDB [Movie]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TheMovieDB (SearchResults Movie)
search
  where
    search :: TheMovieDB (SearchResults Movie)
search = Path -> QueryText -> TheMovieDB (SearchResults Movie)
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse Path
"search/movie" [(Text
"query", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
query)]

-- | Fetch the metadata for the 'Movie' with the given ID.
fetchMovie ::
  -- | TheMovieDB ID for the movie.
  ItemID ->
  TheMovieDB Movie
fetchMovie :: ItemID -> TheMovieDB Movie
fetchMovie ItemID
mid = Path -> QueryText -> TheMovieDB Movie
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse (Path
"movie/" Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ ItemID -> Path
forall b a. (Show a, IsString b) => a -> b
show ItemID
mid) []

-- | Search TheMovieDB for matching 'TV' series.
--
-- The 'TV' values returned from this function will be partial
-- records.  The only fields that will be available are 'tvID',
-- 'tvName', 'tvPosterPath', 'tvPopularity', and possibly
-- 'tvFirstAirDate'.
--
-- To get full 'TV' records you need to follow this function with a
-- call to 'fetchTV' using the desired 'tvID' value.
searchTV :: Text -> TheMovieDB [TV]
searchTV :: Text -> TheMovieDB [TV]
searchTV Text
query = SearchResults TV -> [TV]
forall a. SearchResults a -> [a]
searchResults (SearchResults TV -> [TV])
-> TheMovieDB (SearchResults TV) -> TheMovieDB [TV]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TheMovieDB (SearchResults TV)
search
  where
    search :: TheMovieDB (SearchResults TV)
search = Path -> QueryText -> TheMovieDB (SearchResults TV)
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse Path
"search/tv" [(Text
"query", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
query)]

-- | Fetch metadata for a 'TV' series given its TheMovieDB ID.  The
-- metadata for 'Season's listed in the TV series will not have
-- complete 'Episode' information.
--
-- After calling this function you should call 'fetchTVSeason' to fill
-- in the 'Episode' metadata, or just begin with 'fetchFullTVSeries'.
fetchTV ::
  -- | TheMovieDB ID for the TV series.
  ItemID ->
  TheMovieDB TV
fetchTV :: ItemID -> TheMovieDB TV
fetchTV ItemID
i = Path -> QueryText -> TheMovieDB TV
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse (Path
"tv/" Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ ItemID -> Path
forall b a. (Show a, IsString b) => a -> b
show ItemID
i) []

-- | Fetch metadata for a 'Season', including all 'Episode's.
fetchTVSeason ::
  -- | TheMovieDB ID for the TV series.
  ItemID ->
  -- | Season number (not season ID).
  Int ->
  TheMovieDB Season
fetchTVSeason :: ItemID -> ItemID -> TheMovieDB Season
fetchTVSeason ItemID
i ItemID
n = Path -> QueryText -> TheMovieDB Season
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse (Path
"tv/" Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ ItemID -> Path
forall b a. (Show a, IsString b) => a -> b
show ItemID
i Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ Path
"/season/" Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ ItemID -> Path
forall b a. (Show a, IsString b) => a -> b
show ItemID
n) []

-- | Fetch full metadata for a 'TV' series, including all seasons and
-- episodes.
--
-- This function will make multiple HTTP requests to TheMovieDB API.
fetchFullTVSeries ::
  -- | TheMovieDB ID for the TV series.
  ItemID ->
  TheMovieDB TV
fetchFullTVSeries :: ItemID -> TheMovieDB TV
fetchFullTVSeries ItemID
i = do
  TV
tv <- ItemID -> TheMovieDB TV
fetchTV ItemID
i
  [Season]
seasons <- (Season -> TheMovieDB Season) -> [Season] -> TheMovieDB [Season]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ItemID -> ItemID -> TheMovieDB Season
fetchTVSeason ItemID
i (ItemID -> TheMovieDB Season)
-> (Season -> ItemID) -> Season -> TheMovieDB Season
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Season -> ItemID
seasonNumber) (TV -> [Season]
tvSeasons TV
tv)
  TV -> TheMovieDB TV
forall (m :: * -> *) a. Monad m => a -> m a
return TV
tv {tvSeasons :: [Season]
tvSeasons = [Season]
seasons}

-- | Fetch the API configuration information such as base URLs for
-- movie posters.  The resulting configuration value should be cached
-- and only requested every few days.
config :: TheMovieDB Configuration
config :: TheMovieDB Configuration
config = Path -> QueryText -> TheMovieDB Configuration
forall a. FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse Path
"configuration" []