diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,17 @@ # Version History +## 1.2.0.0 (July 28, 2020) + + - New `Settings` type with the ability to set a preferred ISO 639-1 + language code. Functions that used to take a `Key` now take a + `Settings` value instead. (#5) + + - Removed the `Binary` instance for `Configuration` since the Aeson + instances can be used to serialize to binary. + + - Reformatted all code with Ormolu and refactored some bits to + remove unnecessary dependencies. + ## 1.1.5.2 (April 15, 2019) - Update version of `http-client` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ # Copyright and Authors - Copyright (C) 2012-2019 Peter Jones + Copyright (C) 2012-2020 Peter Jones # License (MIT) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,25 +1,24 @@ -TheMovieDB API for Haskell -========================== +# The Movie Database (TMDb) API for Haskell -This is a simple library that provides functions for retrieving movie -metadata from [TheMovieDB][] API. To use this library you need to -request an API key from TheMovieDB. Follow the directions on the +[![CI](https://github.com/pjones/themoviedb/workflows/CI/badge.svg)](https://github.com/pjones/themoviedb/actions) +[![GitHub tag (latest by date)](https://img.shields.io/github/v/tag/pjones/themoviedb?label=release)](https://github.com/pjones/themoviedb/releases) +[![Hackage](https://img.shields.io/hackage/v/themoviedb)](https://hackage.haskell.org/package/themoviedb) + +This is a simple library that provides functions for retrieving +metadata from the [TMDb][] API. To use this library you need to +request an API key from [TMDb][]. Follow the directions on the [API][] page. -[TheMovieDB]: http://themoviedb.org +[TMDb]: http://themoviedb.org [API]: http://docs.themoviedb.apiary.io -Documentation -============= +## Documentation See the [Network.API.TheMovieDB][] module for complete documentation. -[Network.API.TheMovieDB]: https://github.com/pjones/themoviedb/blob/master/src/Network/API/TheMovieDB.hs +[Network.API.TheMovieDB]: https://hackage.haskell.org/package/themoviedb/docs/Network-API-TheMovieDB.html -Example -======= +## Example -There's an [example][] application in the `example` directory. +There's an [example](example/Main.hs) application in the `example` directory. Surprising, I know. - -[example]: https://github.com/pjones/themoviedb/blob/master/example/Main.hs diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,16 @@ +-- | +-- +-- 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 import Distribution.Simple main = defaultMain diff --git a/example/Main.hs b/example/Main.hs --- a/example/Main.hs +++ b/example/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - {- This file is part of the Haskell package themoviedb. It is subject to @@ -11,72 +9,64 @@ -} --------------------------------------------------------------------------------- module Main (main) where --------------------------------------------------------------------------------- -import Control.Monad.IO.Class (liftIO) -import Data.Maybe (listToMaybe) -import Data.Text (Text) import qualified Data.Text as T -import Data.Time (formatTime) -import Data.Time.Locale.Compat (defaultTimeLocale) +import Data.Time (defaultTimeLocale, formatTime) import Network.API.TheMovieDB import System.Environment (getArgs) -import System.Exit (exitFailure, exitSuccess) +import System.Environment (lookupEnv) import Text.Printf (printf) --------------------------------------------------------------------------------- -- | Simple banner style printing of a 'Movie'. printMovieHeader :: Movie -> IO () printMovieHeader m = printf "%8d: %s (%s)\n" (movieID m) (T.unpack $ movieTitle m) year - where year = case movieReleaseDate m of - Just d -> formatTime defaultTimeLocale "%Y" d - Nothing -> "----" + where + year = case movieReleaseDate m of + Just d -> formatTime defaultTimeLocale "%Y" d + Nothing -> "----" --------------------------------------------------------------------------------- -- | Simple banner style printing of a 'TV'. printTVHeader :: TV -> IO () printTVHeader t = printf "%8d: %s (%s)\n" (tvID t) (T.unpack $ tvName t) year - where year = case tvFirstAirDate t of - Just d -> formatTime defaultTimeLocale "%Y" d - Nothing -> "----" + where + year = case tvFirstAirDate t of + Just d -> formatTime defaultTimeLocale "%Y" d + Nothing -> "----" --------------------------------------------------------------------------------- -- | Print more detailed information for a 'Movie'. printMovieDetails :: Movie -> IO () printMovieDetails m = - do putStrLn $ "Popularity: " ++ show (moviePopularity m) - putStrLn $ strJoin $ map genreName (movieGenres m) - putStrLn "-- " - putStrLn $ T.unpack (movieOverview m) - where strJoin = T.unpack . T.intercalate ", " + do + putStrLn $ "Popularity: " ++ show (moviePopularity m) + putStrLn $ strJoin $ map genreName (movieGenres m) + putStrLn "-- " + putStrLn $ T.unpack (movieOverview m) + where + strJoin = T.unpack . T.intercalate ", " --------------------------------------------------------------------------------- -- | Print information about a season. printSeason :: Season -> IO () printSeason s = - do putStrLn $ "Season " ++ show (seasonNumber s) ++ " " ++ year - mapM_ (putStrLn . episode) $ seasonEpisodes s - + do + putStrLn $ "Season " ++ show (seasonNumber s) ++ " " ++ year + mapM_ (putStrLn . episode) $ seasonEpisodes s where - episode e = "\tE" ++ show (episodeNumber e) ++ " " - ++ T.unpack (episodeName e) - + episode e = + "\tE" ++ show (episodeNumber e) ++ " " + ++ T.unpack (episodeName e) year = case seasonAirDate s of - Just d -> formatTime defaultTimeLocale "%Y" d - Nothing -> "----" + Just d -> formatTime defaultTimeLocale "%Y" d + Nothing -> "----" --------------------------------------------------------------------------------- -- | Search for movies with a query string. searchAndListMovies :: Text -> TheMovieDB () searchAndListMovies query = do movies <- searchMovies query liftIO $ mapM_ printMovieHeader movies --------------------------------------------------------------------------------- -- | Find a specific movie given its ID. fetchAndPrintMovie :: ItemID -> TheMovieDB () fetchAndPrintMovie mid = do @@ -88,14 +78,12 @@ mapM_ (putStrLn . T.unpack) (moviePosterURLs cfg movie) printMovieDetails movie --------------------------------------------------------------------------------- -- | Search for TV series using a query string. searchAndListTV :: Text -> TheMovieDB () searchAndListTV query = do tvs <- searchTV query liftIO $ mapM_ printTVHeader tvs --------------------------------------------------------------------------------- -- | Find a specific TV series given its ID. fetchAndPrintTV :: ItemID -> TheMovieDB () fetchAndPrintTV tid = do @@ -103,52 +91,58 @@ liftIO $ printTVHeader tv liftIO $ mapM_ printSeason (tvSeasons tv) --------------------------------------------------------------------------------- fetchAndPrintSeason :: ItemID -> Int -> TheMovieDB () fetchAndPrintSeason t s = do season <- fetchTVSeason t s liftIO $ printSeason season --------------------------------------------------------------------------------- fetchAndPrintFullTV :: ItemID -> TheMovieDB () fetchAndPrintFullTV t = do tv <- fetchFullTVSeries t liftIO $ printTVHeader tv liftIO $ mapM_ printSeason (tvSeasons tv) --------------------------------------------------------------------------------- -- | Low budget command line parsing and dispatch. main :: IO () main = do args <- getArgs + lang <- lookupEnv "TMDB_LANG" + let key = maybe T.empty T.pack (listToMaybe args) + settings = Settings key (toText <$> lang) - result <- runTheMovieDB key $ + result <- runTheMovieDB settings $ case args of - [_, "search", query] -> searchAndListMovies (T.pack query) - [_, "fetch", mid] -> fetchAndPrintMovie (read mid) + [_, "search", query] -> searchAndListMovies (T.pack query) + [_, "fetch", mid] -> itemID fetchAndPrintMovie mid [_, "tsearch", query] -> searchAndListTV (T.pack query) - [_, "tfetch", tid] -> fetchAndPrintTV (read tid) - [_, "season", t, s] -> fetchAndPrintSeason (read t) (read s) - [_, "tfull", t] -> fetchAndPrintFullTV (read t) - _ -> liftIO (putStrLn usage >> exitFailure) + [_, "tfetch", tid] -> itemID fetchAndPrintTV tid + [_, "season", t, s] -> itemID (\t -> itemID (fetchAndPrintSeason t) s) t + [_, "tfull", t] -> itemID fetchAndPrintFullTV t + _ -> liftIO (putStrLn usage >> exitFailure) case result of Left err -> print err >> exitFailure - Right _ -> exitSuccess - - where usage = "Usage: tmdb key {search|fetch|tsearch|tfetch|season|tfull}\n\n" ++ - "Description:\n" ++ - " search: search TheMovieDB\n" ++ - " fetch: fetch info about one movie\n" ++ - " tsearch: search for TV series\n" ++ - " tfetch: fetch TV series by ID\n" ++ - " season: fetch one season by TV ID and season num\n" ++ - " tfull: pull everything about TV series by ID\n" ++ - "Examples:\n" ++ - " tmdb KEY search \"back to the future\"\n" ++ - " tmdb KEY fetch 105\n" ++ - " tmdb KEY tsearch Firefly\n" ++ - " tmdb KEY tfetch 1437\n" ++ - " tmdb KEY season 1437 1\n" ++ - " tmdb KEY tfull 1437\n" + Right _ -> exitSuccess + where + itemID :: MonadIO m => (ItemID -> m a) -> String -> m a + itemID f str = + case readMaybe str of + Nothing -> die ("invalid ID: " <> str) + Just n -> f n + usage = + "Usage: tmdb key {search|fetch|tsearch|tfetch|season|tfull}\n\n" + ++ "Description:\n" + ++ " search: search TheMovieDB\n" + ++ " fetch: fetch info about one movie\n" + ++ " tsearch: search for TV series\n" + ++ " tfetch: fetch TV series by ID\n" + ++ " season: fetch one season by TV ID and season num\n" + ++ " tfull: pull everything about TV series by ID\n" + ++ "Examples:\n" + ++ " tmdb KEY search \"back to the future\"\n" + ++ " tmdb KEY fetch 105\n" + ++ " tmdb KEY tsearch Firefly\n" + ++ " tmdb KEY tfetch 1437\n" + ++ " tmdb KEY season 1437 1\n" + ++ " tmdb KEY tfull 1437\n" diff --git a/src/Network/API/TheMovieDB.hs b/src/Network/API/TheMovieDB.hs --- a/src/Network/API/TheMovieDB.hs +++ b/src/Network/API/TheMovieDB.hs @@ -1,74 +1,81 @@ -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - -{- | - -This library provides some data types and functions for fetching movie -metadata from . To use this library start by -requesting an API key from . - -Example: - -@ -import Network.API.TheMovieDB - -main :: IO () -main = do - -- The API key assigned to you (as a 'Text' value). - let key = "your API key" - - -- The 'fetch' function will get a 'Movie' record based on its ID. - result <- runTheMovieDB key (fetchMovie 9340) - - -- Do something with the result (or error). - putStrLn (show result) -@ - -This library also includes an example executable in the @example@ -directory. --} +-- | +-- +-- 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 +-- +-- This library provides some data types and functions for fetching movie +-- metadata from . To use this library start by +-- requesting an API key from . +-- +-- Example: +-- +-- @ +-- import Network.API.TheMovieDB +-- +-- main :: IO () +-- main = do +-- -- The API key assigned to you (as a 'Text' value). +-- let key = "your API key" +-- +-- -- The 'fetch' function will get a 'Movie' record based on its ID. +-- result <- runTheMovieDB (defaultSettings key) (fetchMovie 9340) +-- +-- -- Do something with the result (or error). +-- putStrLn (show result) +-- @ +-- +-- This library also includes an example executable in the @example@ +-- directory. module Network.API.TheMovieDB ( -- * Types - Movie (..) - , TV (..) - , Season (..) - , Episode (..) - , Genre (..) - , Error (..) - , ItemID - , Key + Movie (..), + TV (..), + Season (..), + Episode (..), + Genre (..), + Error (..), + ItemID, + -- * Library Settings + Settings (..), + defaultSettings, + Key, + LanguageCode, + -- * API Functions - , TheMovieDB - , runTheMovieDB - , runTheMovieDBWithManager - , searchMovies - , fetchMovie - , searchTV - , fetchTV - , fetchTVSeason - , fetchFullTVSeries + TheMovieDB, + runTheMovieDB, + runTheMovieDBWithManager, + searchMovies, + fetchMovie, + searchTV, + fetchTV, + fetchTVSeason, + fetchFullTVSeries, -- * Utility Types and Functions - , Configuration - , config - , moviePosterURLs - , tvPosterURLs - , seasonPosterURLs - , episodeStillURLs - ) where + Configuration, + config, + moviePosterURLs, + tvPosterURLs, + seasonPosterURLs, + episodeStillURLs, + ) +where --------------------------------------------------------------------------------- import Network.API.TheMovieDB.Actions import Network.API.TheMovieDB.Internal.Configuration +import Network.API.TheMovieDB.Internal.Settings import Network.API.TheMovieDB.Internal.TheMovieDB import Network.API.TheMovieDB.Internal.Types import Network.API.TheMovieDB.Types.Episode diff --git a/src/Network/API/TheMovieDB/Actions.hs b/src/Network/API/TheMovieDB/Actions.hs --- a/src/Network/API/TheMovieDB/Actions.hs +++ b/src/Network/API/TheMovieDB/Actions.hs @@ -1,30 +1,28 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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 + ( searchMovies, + fetchMovie, + searchTV, + fetchTV, + fetchTVSeason, + fetchFullTVSeries, + config, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative -import Data.Text (Text) import Network.API.TheMovieDB.Internal.Configuration import Network.API.TheMovieDB.Internal.SearchResults import Network.API.TheMovieDB.Internal.TheMovieDB @@ -33,13 +31,6 @@ import Network.API.TheMovieDB.Types.Season import Network.API.TheMovieDB.Types.TV --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Search TheMovieDB using the given query string. -- -- The movies returned will not have all their fields completely @@ -47,15 +38,16 @@ -- call up with a call to 'fetchMovie'. searchMovies :: Text -> TheMovieDB [Movie] searchMovies query = searchResults <$> search - where search = getAndParse "search/movie" [("query", Just query)] + where + search = getAndParse "search/movie" [("query", Just query)] --------------------------------------------------------------------------------- -- | Fetch the metadata for the 'Movie' with the given ID. -fetchMovie :: ItemID -- ^ TheMovieDB ID for the movie. - -> TheMovieDB Movie +fetchMovie :: + -- | TheMovieDB ID for the movie. + ItemID -> + TheMovieDB Movie fetchMovie mid = getAndParse ("movie/" ++ show mid) [] --------------------------------------------------------------------------------- -- | Search TheMovieDB for matching 'TV' series. -- -- The 'TV' values returned from this function will be partial @@ -67,39 +59,43 @@ -- call to 'fetchTV' using the desired 'tvID' value. searchTV :: Text -> TheMovieDB [TV] searchTV query = searchResults <$> search - where search = getAndParse "search/tv" [("query", Just query)] + where + search = getAndParse "search/tv" [("query", Just 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 :: ItemID -- ^ TheMovieDB ID for the TV series. - -> TheMovieDB TV +fetchTV :: + -- | TheMovieDB ID for the TV series. + ItemID -> + TheMovieDB TV fetchTV i = getAndParse ("tv/" ++ show i) [] --------------------------------------------------------------------------------- -- | Fetch metadata for a 'Season', including all 'Episode's. -fetchTVSeason :: ItemID -- ^ TheMovieDB ID for the TV series. - -> Int -- ^ Season number (not season ID). - -> TheMovieDB Season +fetchTVSeason :: + -- | TheMovieDB ID for the TV series. + ItemID -> + -- | Season number (not season ID). + Int -> + TheMovieDB Season fetchTVSeason i n = getAndParse ("tv/" ++ show i ++ "/season/" ++ show n) [] --------------------------------------------------------------------------------- -- | Fetch full metadata for a 'TV' series, including all seasons and -- episodes. -- -- This function will make multiple HTTP requests to TheMovieDB API. -fetchFullTVSeries :: ItemID -- ^ TheMovieDB ID for the TV series. - -> TheMovieDB TV +fetchFullTVSeries :: + -- | TheMovieDB ID for the TV series. + ItemID -> + TheMovieDB TV fetchFullTVSeries i = do - tv <- fetchTV i + tv <- fetchTV i seasons <- mapM (fetchTVSeason i . seasonNumber) (tvSeasons tv) return tv {tvSeasons = 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. diff --git a/src/Network/API/TheMovieDB/Internal/Configuration.hs b/src/Network/API/TheMovieDB/Internal/Configuration.hs --- a/src/Network/API/TheMovieDB/Internal/Configuration.hs +++ b/src/Network/API/TheMovieDB/Internal/Configuration.hs @@ -1,33 +1,27 @@ -{-# LANGUAGE OverloadedStrings, DeriveGeneric #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- --- | Internal configuration information for TheMovieDB API. +-- | +-- +-- 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 + ( Configuration (..), + posterURLs, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Binary -import Data.Monoid -import Data.Text (Text) -import Data.Text.Binary () -import GHC.Generics (Generic) --------------------------------------------------------------------------------- -- | 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 @@ -39,40 +33,37 @@ -- -- According to the API documentation for TheMovieDB, you should cache -- the 'Configuration' value and only request it every few days. --- Therefore, it is an instance of the 'Binary' class so it can be --- serialized to and from a cache file on disk. --- --- Alternatively, the 'FromJSON' and 'ToJSON' instances can be used to --- cache the 'Configuration' value. data Configuration = Configuration - { cfgImageBaseURL :: Text -- ^ The base URL for images. - , cfgImageSecBaseURL :: Text -- ^ Base URL for secure images. - , cfgPosterSizes :: [Text] -- ^ List of possible image sizes. - } deriving (Generic) - --------------------------------------------------------------------------------- -instance Binary Configuration + { -- | The base URL for images. + cfgImageBaseURL :: Text, + -- | Base URL for secure images. + cfgImageSecBaseURL :: Text, + -- | List of possible image sizes. + cfgPosterSizes :: [Text] + } + deriving (Generic) --------------------------------------------------------------------------------- instance FromJSON Configuration where - parseJSON (Object v) = - Configuration <$> images "base_url" - <*> images "secure_base_url" - <*> imagesM "poster_sizes" [] - where images key = (v .: "images") >>= (.: key) - imagesM key def = (v .: "images") >>= (\x -> x .:? key .!= def) - parseJSON _ = empty + parseJSON = withObject "Configuration" $ \v -> + Configuration + <$> images v "base_url" + <*> images v "secure_base_url" + <*> imagesM v "poster_sizes" [] + where + images v key = (v .: "images") >>= (.: key) + imagesM v key def = (v .: "images") >>= (\x -> x .:? key .!= def) --------------------------------------------------------------------------------- instance ToJSON Configuration where - toJSON c = object [ "images" .= object - [ "base_url" .= cfgImageBaseURL c - , "secure_base_url" .= cfgImageSecBaseURL c - , "poster_sizes" .= cfgPosterSizes c - ]] - + toJSON c = + object + [ "images" + .= object + [ "base_url" .= cfgImageBaseURL c, + "secure_base_url" .= cfgImageSecBaseURL c, + "poster_sizes" .= cfgPosterSizes c + ] + ] --------------------------------------------------------------------------------- --- | Return a list of URLs for all possible posters posters. +-- | Return a list of URLs for all possible posters. posterURLs :: Configuration -> Text -> [Text] posterURLs c p = [cfgImageBaseURL c <> size <> p | size <- cfgPosterSizes c] diff --git a/src/Network/API/TheMovieDB/Internal/Date.hs b/src/Network/API/TheMovieDB/Internal/Date.hs --- a/src/Network/API/TheMovieDB/Internal/Date.hs +++ b/src/Network/API/TheMovieDB/Internal/Date.hs @@ -1,61 +1,55 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- --- | Utility type for working with release dates. +-- | +-- +-- 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 +-- +-- Utility type for working with release dates. module Network.API.TheMovieDB.Internal.Date - ( Date (..) - , parseDay - , (.::) - ) where + ( Date (..), + parseDay, + (.::), + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson import Data.Aeson.Types (Parser, typeMismatch) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (Day(..), parseTimeM) -import Data.Time.Locale.Compat (defaultTimeLocale) +import qualified Data.Text as Text +import Data.Time (Day (..), parseTimeM) +import Data.Time.Format (defaultTimeLocale) --------------------------------------------------------------------------------- -- | A simple type wrapper around 'Day' in order to parse a movie's -- release date, which may be null or empty. newtype Date = Date {day :: Maybe Day} deriving (Eq, Show) --------------------------------------------------------------------------------- -- | Aeson helper function to parse dates in TheMovieDB API. parseDay :: Object -> Text -> Parser (Maybe Day) -parseDay v key = - do m <- date - return $ case m of - Nothing -> Nothing - Just d -> day d +parseDay v key = do + m <- date + return (m >>= day) where date :: Parser (Maybe Date) date = v .:? key <|> pure Nothing --------------------------------------------------------------------------------- +-- | Infix alias for 'parseDay'. (.::) :: Object -> Text -> Parser (Maybe Day) (.::) = parseDay --------------------------------------------------------------------------------- -- | Parse release dates in JSON. instance FromJSON Date where parseJSON Null = return (Date Nothing) parseJSON (String t) - | T.null t = return (Date Nothing) - | otherwise = do d <- parseTimeM True defaultTimeLocale "%Y-%m-%d" (T.unpack t) - return $ Date (Just d) - + | Text.null t = return (Date Nothing) + | otherwise = do + d <- parseTimeM True defaultTimeLocale "%Y-%m-%d" (toString t) + return $ Date (Just d) parseJSON v = typeMismatch "Date" v diff --git a/src/Network/API/TheMovieDB/Internal/HTTP.hs b/src/Network/API/TheMovieDB/Internal/HTTP.hs --- a/src/Network/API/TheMovieDB/Internal/HTTP.hs +++ b/src/Network/API/TheMovieDB/Internal/HTTP.hs @@ -1,69 +1,73 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- --- | Simple interface for fetching JSON files from the API via HTTP. +-- | +-- +-- 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 +-- +-- Simple interface for fetching JSON files from the API via HTTP. module Network.API.TheMovieDB.Internal.HTTP - ( apiGET - ) where + ( apiBaseURL, + defaultImagePrefix, + apiGET, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Control.Exception +import Network.API.TheMovieDB.Internal.Settings import Network.API.TheMovieDB.Internal.Types import qualified Network.HTTP.Client as HC import Network.HTTP.Types --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | The base URL for the version of the API we're using. apiBaseURL :: String apiBaseURL = "https://api.themoviedb.org/3/" --------------------------------------------------------------------------------- +-- | The default image URL prefix. +defaultImagePrefix :: Text +defaultImagePrefix = "http://image.tmdb.org/t/p/" + -- | Build a HTTP request that can be used to access the API. -mkAPIRequest :: Key -> Path -> QueryText -> IO HC.Request -mkAPIRequest key path params = do +mkAPIRequest :: Settings -> Path -> QueryText -> IO HC.Request +mkAPIRequest Settings {..} path params = do req <- HC.parseRequest (apiBaseURL ++ path) - return $ req { HC.queryString = query - , HC.requestHeaders = headers - } - + return $ + req + { HC.queryString = query, + HC.requestHeaders = headers + } where - query = renderQuery False . queryTextToQuery $ allParams - allParams = params ++ [("api_key", Just key)] - headers = [("Accept", "application/json")] + query = renderQuery False . queryTextToQuery $ allParams + headers = [("Accept", "application/json")] + allParams = + params + ++ ( second Just + <$> catMaybes + [ Just ("api_key", tmdbKey), + ("language",) <$> tmdbLanguage + ] + ) --------------------------------------------------------------------------------- -- | Build a URL and do an HTTP GET to TheMovieDB. -apiGET :: HC.Manager -> Key -> Path -> QueryText -> IO (Either Error Body) -apiGET manager key path params = do - request <- mkAPIRequest key path params +apiGET :: HC.Manager -> Settings -> Path -> QueryText -> IO (Either Error Body) +apiGET manager settings path params = do + request <- mkAPIRequest settings path params response <- catch (Right <$> HC.httpLbs request manager) httpError - return $ case response of - Left e -> Left e + Left e -> Left e Right r | statusIsSuccessful (HC.responseStatus r) -> Right (HC.responseBody r) | otherwise -> Left (ServiceError . show $ HC.responseStatus r) - where -- This should only be called for non-200 codes now. httpError :: HC.HttpException -> IO (Either Error (HC.Response Body)) diff --git a/src/Network/API/TheMovieDB/Internal/SearchResults.hs b/src/Network/API/TheMovieDB/Internal/SearchResults.hs --- a/src/Network/API/TheMovieDB/Internal/SearchResults.hs +++ b/src/Network/API/TheMovieDB/Internal/SearchResults.hs @@ -1,32 +1,31 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- --- | Utility type for processing movie search results. +-- | +-- +-- 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 +-- +-- Utility type for processing movie search results. module Network.API.TheMovieDB.Internal.SearchResults - ( SearchResults (..) - ) where + ( SearchResults (..), + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson --------------------------------------------------------------------------------- -- | Internal wrapper to parse a list of results from JSON. newtype SearchResults a = SearchResults {searchResults :: [a]} - deriving (Eq, Show) + deriving (Eq, Show) --------------------------------------------------------------------------------- instance (FromJSON a) => FromJSON (SearchResults a) where - parseJSON (Object v) = SearchResults <$> v .: "results" - parseJSON _ = empty + parseJSON = withObject "Search Results" $ \v -> + SearchResults + <$> v .: "results" diff --git a/src/Network/API/TheMovieDB/Internal/Settings.hs b/src/Network/API/TheMovieDB/Internal/Settings.hs new file mode 100644 --- /dev/null +++ b/src/Network/API/TheMovieDB/Internal/Settings.hs @@ -0,0 +1,51 @@ +-- | +-- +-- 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. + tmdbKey :: Key, + -- | Optional ISO 639-1 language code to send with every request. + tmdbLanguage :: Maybe LanguageCode + } + +instance FromJSON Settings where + parseJSON = withObject "Settings" $ \v -> + Settings + <$> v .: "key" + <*> v .: "lang" + +instance ToJSON Settings where + toJSON Settings {..} = + object + [ "key" .= tmdbKey, + "lang" .= tmdbLanguage + ] + +-- | Default settings. +defaultSettings :: Key -> Settings +defaultSettings key = + Settings + { tmdbKey = key, + tmdbLanguage = Nothing + } diff --git a/src/Network/API/TheMovieDB/Internal/TheMovieDB.hs b/src/Network/API/TheMovieDB/Internal/TheMovieDB.hs --- a/src/Network/API/TheMovieDB/Internal/TheMovieDB.hs +++ b/src/Network/API/TheMovieDB/Internal/TheMovieDB.hs @@ -1,111 +1,106 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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.TheMovieDB - ( TheMovieDB - , RequestFunction - , getAndParse - , tmdbError - , runTheMovieDB - , runTheMovieDBWithManager - , runTheMovieDBWithRequestFunction - ) where + ( TheMovieDB, + RequestFunction, + getAndParse, + tmdbError, + runTheMovieDB, + runTheMovieDBWithManager, + runTheMovieDBWithRequestFunction, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative -import Control.Monad.Reader -import Control.Monad.Trans.Except +import Control.Monad.Except import Data.Aeson import Network.API.TheMovieDB.Internal.HTTP +import Network.API.TheMovieDB.Internal.Settings import Network.API.TheMovieDB.Internal.Types import Network.HTTP.Client (Manager, newManager) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | The type for functions that make requests to the API (or pretend -- to make a request for testing purposes). type RequestFunction = (Path -> QueryText -> IO (Either Error Body)) --------------------------------------------------------------------------------- -- | Result type for operations involving TheMovieDB API. -newtype TheMovieDB a = - TheMovieDB {unTMDB :: ReaderT RequestFunction (ExceptT Error IO) a} - deriving (Functor, Applicative, Monad, MonadIO) +newtype TheMovieDB a = TheMovieDB + {unTMDB :: ReaderT RequestFunction (ExceptT Error IO) a} + deriving newtype (Functor, Applicative, Monad, MonadIO) --------------------------------------------------------------------------------- -- | Helper function for making a request using the request function -- stashed away in the reader monad. runRequest :: Path -> QueryText -> TheMovieDB Body runRequest path params = TheMovieDB $ do - func <- ask + func <- ask lift (ExceptT $ liftIO (func path params)) --------------------------------------------------------------------------------- -- | Helper function to preform an HTTP GET and decode the JSON result. getAndParse :: FromJSON a => Path -> QueryText -> TheMovieDB a getAndParse path params = do body <- runRequest path params case eitherDecode body of - Left e -> tmdbError $ ResponseParseError ("bad JSON: " ++ e) (Just body) + Left e -> tmdbError $ ResponseParseError ("bad JSON: " ++ e) (Just body) Right a -> return a --------------------------------------------------------------------------------- -- | Create a 'TheMovieDB' value representing an error. tmdbError :: Error -> TheMovieDB a -tmdbError = TheMovieDB . lift . throwE +tmdbError = TheMovieDB . throwError --------------------------------------------------------------------------------- -- | Execute requests for TheMovieDB with the given API key and produce -- either an error or a result. -- -- This version creates a temporary 'Manager' using -- 'tlsManagerSettings'. If you want to use an existing 'Manager' you -- should use 'runTheMovieDBWithManager' instead. -runTheMovieDB - :: Key -- ^ The API key to include in all requests. - -> TheMovieDB a -- ^ The API calls to make. - -> IO (Either Error a) -- ^ Response or error. -runTheMovieDB k t = do m <- newManager tlsManagerSettings - runTheMovieDBWithManager m k t - -- No need to closeManager anymore. +runTheMovieDB :: + -- | Library settings. + Settings -> + -- | The API calls to make. + TheMovieDB a -> + -- | Response or error. + IO (Either Error a) +runTheMovieDB s t = do + m <- newManager tlsManagerSettings + runTheMovieDBWithManager m s t --------------------------------------------------------------------------------- -- | Execute requests for TheMovieDB with the given API key and produce -- either an error or a result. -- -- This version allows you to provide a 'Manager' value which should -- have been created to allow TLS requests (e.g., with 'tlsManagerSettings'). -runTheMovieDBWithManager - :: Manager -- ^ The 'Manager' to use. - -> Key -- ^ The API key to include in all requests. - -> TheMovieDB a -- ^ The API calls to make. - -> IO (Either Error a) -- ^ Response or error. -runTheMovieDBWithManager m k = runTheMovieDBWithRequestFunction (apiGET m k) +runTheMovieDBWithManager :: + -- | The 'Manager' to use. + Manager -> + -- | Library settings. + Settings -> + -- | The API calls to make. + TheMovieDB a -> + -- | Response or error. + IO (Either Error a) +runTheMovieDBWithManager m s = runTheMovieDBWithRequestFunction (apiGET m s) --------------------------------------------------------------------------------- -- | Low-level interface for executing a 'TheMovieDB' using the given -- request function. -runTheMovieDBWithRequestFunction - :: RequestFunction -- ^ The request function to use. - -> TheMovieDB a -- ^ The API calls to make. - -> IO (Either Error a) -- ^ Response. +runTheMovieDBWithRequestFunction :: + -- | The request function to use. + RequestFunction -> + -- | The API calls to make. + TheMovieDB a -> + -- | Response. + IO (Either Error a) runTheMovieDBWithRequestFunction f t = runExceptT $ runReaderT (unTMDB t) f diff --git a/src/Network/API/TheMovieDB/Internal/Types.hs b/src/Network/API/TheMovieDB/Internal/Types.hs --- a/src/Network/API/TheMovieDB/Internal/Types.hs +++ b/src/Network/API/TheMovieDB/Internal/Types.hs @@ -1,64 +1,60 @@ -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- --- | Simple types and synonyms, mostly to make the type signatures +-- | +-- +-- 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 +-- +-- Simple types and synonyms, mostly to make the type signatures -- easier to read. module Network.API.TheMovieDB.Internal.Types - ( ItemID - , Key - , Body - , Path - , Error (..) - ) where + ( ItemID, + Key, + LanguageCode, + Body, + Path, + Error (..), + ) +where --------------------------------------------------------------------------------- -import Data.ByteString.Lazy (ByteString) -import Data.Text (Text) import Network.HTTP.Client (HttpException) --------------------------------------------------------------------------------- -- | Type to represent IDs used by the API. type ItemID = Int --------------------------------------------------------------------------------- -- | Type for the API key issued by TheMovieDB. type Key = Text --------------------------------------------------------------------------------- +-- | Type for selecting a TMDb language in ISO 639-1 format. +type LanguageCode = Text + -- | URL path. type Path = String - --------------------------------------------------------------------------------- --- | HTTP body. -type Body = ByteString --------------------------------------------------------------------------------- --- | Possible errors returned by the API. -data Error = InvalidKeyError - -- ^ Missing or invalid API key. Make sure you are using - -- a valid API key issued by - -- . - - | HttpExceptionError HttpException - -- ^ An exception relating to HTTP was thrown while - -- interacting with the API. - - | ServiceError String - -- ^ The HTTP interaction with the API service did not - -- result in a successful response. Information about - -- the failure is encoded in the String. - - | ResponseParseError String (Maybe ByteString) - -- ^ Invalid or error response from the API. - - deriving (Show) +-- | HTTP body. +type Body = LByteString +-- | Possible errors returned by the API. +data Error + = -- | Missing or invalid API key. Make sure you are using + -- a valid API key issued by + -- . + InvalidKeyError + | -- | An exception relating to HTTP was thrown while + -- interacting with the API. + HttpExceptionError HttpException + | -- | The HTTP interaction with the API service did not + -- result in a successful response. Information about + -- the failure is encoded in the String. + ServiceError String + | -- | Invalid or error response from the API. + ResponseParseError String (Maybe LByteString) + deriving (Show) diff --git a/src/Network/API/TheMovieDB/Types/Episode.hs b/src/Network/API/TheMovieDB/Types/Episode.hs --- a/src/Network/API/TheMovieDB/Types/Episode.hs +++ b/src/Network/API/TheMovieDB/Types/Episode.hs @@ -1,87 +1,69 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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.Episode - ( Episode (..) - , episodeStillURLs - ) where + ( Episode (..), + episodeStillURLs, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) import Data.Time (Day (..)) import Network.API.TheMovieDB.Internal.Configuration import Network.API.TheMovieDB.Internal.Date import Network.API.TheMovieDB.Internal.Types --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Metadata for a TV Episode. -- -- * The 'episodeStillPath' field is an incomplete URL. To -- construct a complete URL you'll need to use the 'Configuration' -- type and the 'episodeStillURLs' helper function. data Episode = Episode - { episodeID :: ItemID - -- ^ TheMovieDB unique ID. - - , episodeNumber :: Int - -- ^ Episode sequence number. - - , episodeName :: Text - -- ^ Episode name. - - , episodeOverview :: Text - -- ^ Short description of the episode. - - , episodeSeasonNumber :: Int - -- ^ The season this episode belongs to. - - , episodeAirDate :: Maybe Day - -- ^ Episode air date, if it ever aired. - - , episodeStillPath :: Text - -- ^ Incomplete URL to a still image from the episode. See the + { -- | TheMovieDB unique ID. + episodeID :: ItemID, + -- | Episode sequence number. + episodeNumber :: Int, + -- | Episode name. + episodeName :: Text, + -- | Short description of the episode. + episodeOverview :: Text, + -- | The season this episode belongs to. + episodeSeasonNumber :: Int, + -- | Episode air date, if it ever aired. + episodeAirDate :: Maybe Day, + -- | Incomplete URL to a still image from the episode. See the -- 'episodeStillURLs' function for more information. - - } deriving (Eq, Show) + episodeStillPath :: Text + } + deriving (Eq, Show) --------------------------------------------------------------------------------- instance Ord Episode where - compare a b = compare (episodeSeasonNumber a, episodeNumber a) - (episodeSeasonNumber b, episodeNumber b) + compare a b = + compare + (episodeSeasonNumber a, episodeNumber a) + (episodeSeasonNumber b, episodeNumber b) --------------------------------------------------------------------------------- instance FromJSON Episode where - parseJSON (Object v) = - Episode <$> v .: "id" - <*> v .: "episode_number" - <*> v .: "name" - <*> v .: "overview" - <*> v .: "season_number" .!= 0 - <*> v .:: "air_date" - <*> v .: "still_path" .!= "" - parseJSON v = typeMismatch "Episode" v + parseJSON = withObject "Episode" $ \v -> + Episode <$> v .: "id" + <*> v .: "episode_number" + <*> v .: "name" + <*> v .: "overview" + <*> v .: "season_number" .!= 0 + <*> v .:: "air_date" + <*> v .: "still_path" .!= "" --------------------------------------------------------------------------------- -- | Return a list of URLs for all possible episode still images. episodeStillURLs :: Configuration -> Episode -> [Text] episodeStillURLs c e = posterURLs c (episodeStillPath e) diff --git a/src/Network/API/TheMovieDB/Types/Genre.hs b/src/Network/API/TheMovieDB/Types/Genre.hs --- a/src/Network/API/TheMovieDB/Types/Genre.hs +++ b/src/Network/API/TheMovieDB/Types/Genre.hs @@ -1,42 +1,36 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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 + ( Genre (..), + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) import Network.API.TheMovieDB.Internal.Types --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Metadata for a genre. data Genre = Genre - { genreID :: ItemID -- ^ TheMovieDB unique ID. - , genreName :: Text -- ^ The name of the genre. - } deriving (Eq, Show) + { -- | TheMovieDB unique ID. + genreID :: ItemID, + -- | The name of the genre. + genreName :: Text + } + deriving (Eq, Show) --------------------------------------------------------------------------------- instance FromJSON Genre where - parseJSON (Object v) = Genre <$> v .: "id" <*> v .: "name" - parseJSON v = typeMismatch "Genre" v + parseJSON = withObject "Genre" $ \v -> + Genre + <$> v .: "id" + <*> v .: "name" diff --git a/src/Network/API/TheMovieDB/Types/Movie.hs b/src/Network/API/TheMovieDB/Types/Movie.hs --- a/src/Network/API/TheMovieDB/Types/Movie.hs +++ b/src/Network/API/TheMovieDB/Types/Movie.hs @@ -1,94 +1,73 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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 + ( Movie (..), + moviePosterURLs, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) 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 --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | 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 - { movieID :: ItemID - -- ^ TheMovieDB unique ID. - - , movieTitle :: Text - -- ^ The name/title of the movie. - - , movieOverview :: Text - -- ^ Short plot summary. - - , movieGenres :: [Genre] - -- ^ List of 'Genre's. - - , moviePopularity :: Double - -- ^ Popularity ranking. - - , moviePosterPath :: Text - -- ^ Incomplete URL for poster image. See 'moviePosterURLs'. - - , movieReleaseDate :: Maybe Day - -- ^ Movie release date. (Movie may not have been released yet.) - - , movieAdult :: Bool - -- ^ TheMovieDB adult movie flag. - - , movieIMDB :: Text - -- ^ IMDB.com ID. - - , movieRunTime :: Int - -- ^ Movie length in minutes. - - } deriving (Eq, Show) + { -- | TheMovieDB unique ID. + movieID :: ItemID, + -- | The name/title of the movie. + movieTitle :: Text, + -- | Short plot summary. + movieOverview :: Text, + -- | List of 'Genre's. + movieGenres :: [Genre], + -- | Popularity ranking. + moviePopularity :: Double, + -- | Incomplete URL for poster image. See 'moviePosterURLs'. + moviePosterPath :: Text, + -- | Movie release date. (Movie may not have been released yet.) + movieReleaseDate :: Maybe Day, + -- | TheMovieDB adult movie flag. + movieAdult :: Bool, + -- | IMDB.com ID. + movieIMDB :: Text, + -- | Movie length in minutes. + movieRunTime :: Int + } + deriving (Eq, Show) --------------------------------------------------------------------------------- instance FromJSON Movie where - parseJSON (Object v) = - Movie <$> v .: "id" - <*> v .: "title" - <*> v .:? "overview" .!= "" - <*> v .:? "genres" .!= [] - <*> v .:? "popularity" .!= 0.0 - <*> v .:? "poster_path" .!= "" - <*> v .:: "release_date" - <*> v .:? "adult" .!= False - <*> v .:? "imdb_id" .!= "" - <*> v .:? "runtime" .!= 0 - parseJSON v = typeMismatch "Movie" v + parseJSON = withObject "Movie" $ \v -> + Movie + <$> v .: "id" + <*> v .: "title" + <*> v .:? "overview" .!= "" + <*> v .:? "genres" .!= [] + <*> v .:? "popularity" .!= 0.0 + <*> v .:? "poster_path" .!= "" + <*> v .:: "release_date" + <*> v .:? "adult" .!= False + <*> v .:? "imdb_id" .!= "" + <*> v .:? "runtime" .!= 0 --------------------------------------------------------------------------------- -- | Return a list of URLs for all possible movie posters. moviePosterURLs :: Configuration -> Movie -> [Text] moviePosterURLs c m = posterURLs c (moviePosterPath m) diff --git a/src/Network/API/TheMovieDB/Types/Season.hs b/src/Network/API/TheMovieDB/Types/Season.hs --- a/src/Network/API/TheMovieDB/Types/Season.hs +++ b/src/Network/API/TheMovieDB/Types/Season.hs @@ -1,83 +1,65 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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.Season - ( Season (..) - , seasonPosterURLs - ) where + ( Season (..), + seasonPosterURLs, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) 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.Episode --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Metadata for a TV Season. -- -- * The 'seasonPosterPath' field is an incomplete URL. To -- construct a complete URL you'll need to use the 'Configuration' -- type and the 'seasonPosterURLs' helper function. data Season = Season - { seasonID :: ItemID - -- ^ TheMovieDB unique ID. - - , seasonNumber :: Int - -- ^ Season sequence number. Remember that season 0 is sometimes + { -- | TheMovieDB unique ID. + seasonID :: ItemID, + -- | Season sequence number. Remember that season 0 is sometimes -- used to hold unreleased/unaired episodes. - - , seasonAirDate :: Maybe Day - -- ^ The date this season began to air, if ever. - - , seasonEpisodeCount :: Int - -- ^ Number of episodes in this season. - - , seasonPosterPath :: Text - -- ^ Incomplete URL for poster image. See 'seasonPosterURLs'. - - , seasonEpisodes :: [Episode] - -- ^ List of 'Episode's. - - } deriving (Eq, Show) + seasonNumber :: Int, + -- | The date this season began to air, if ever. + seasonAirDate :: Maybe Day, + -- | Number of episodes in this season. + seasonEpisodeCount :: Int, + -- | Incomplete URL for poster image. See 'seasonPosterURLs'. + seasonPosterPath :: Text, + -- | List of 'Episode's. + seasonEpisodes :: [Episode] + } + deriving (Eq, Show) --------------------------------------------------------------------------------- instance Ord Season where compare a b = seasonNumber a `compare` seasonNumber b --------------------------------------------------------------------------------- instance FromJSON Season where - parseJSON (Object v) = - Season <$> v .: "id" - <*> v .: "season_number" .!= 0 - <*> v .:: "air_date" - <*> v .:? "episode_count" .!= 0 - <*> v .: "poster_path" .!= "" - <*> v .:? "episodes" .!= [] - parseJSON v = typeMismatch "Season" v + parseJSON = withObject "Season" $ \v -> + Season + <$> v .: "id" + <*> v .: "season_number" .!= 0 + <*> v .:: "air_date" + <*> v .:? "episode_count" .!= 0 + <*> v .: "poster_path" .!= "" + <*> v .:? "episodes" .!= [] --------------------------------------------------------------------------------- -- | Return a list of URLs for all possible season posters. seasonPosterURLs :: Configuration -> Season -> [Text] seasonPosterURLs c s = posterURLs c (seasonPosterPath s) diff --git a/src/Network/API/TheMovieDB/Types/TV.hs b/src/Network/API/TheMovieDB/Types/TV.hs --- a/src/Network/API/TheMovieDB/Types/TV.hs +++ b/src/Network/API/TheMovieDB/Types/TV.hs @@ -1,27 +1,24 @@ -{-# LANGUAGE OverloadedStrings #-} - -{- - -This file is part of the Haskell package themoviedb. It is subject to -the license terms in the LICENSE file found in the top-level directory -of this distribution and at git://pmade.com/themoviedb/LICENSE. No -part of themoviedb package, including this file, may be copied, -modified, propagated, or distributed except according to the terms -contained in the LICENSE file. - --} - --------------------------------------------------------------------------------- +-- | +-- +-- 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.TV - ( TV(..) - , tvPosterURLs - ) where + ( TV (..), + tvPosterURLs, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative import Data.Aeson -import Data.Aeson.Types (typeMismatch) -import Data.Text (Text) import Data.Time (Day (..)) import Network.API.TheMovieDB.Internal.Configuration import Network.API.TheMovieDB.Internal.Date @@ -29,81 +26,61 @@ import Network.API.TheMovieDB.Types.Genre import Network.API.TheMovieDB.Types.Season --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- -- | Metadata for a TV series. -- -- * The 'tvPosterPath' field is an incomplete URL. To construct a -- complete URL you'll need to use the 'Configuration' type and the -- 'tvPosterURLs' helper function. data TV = TV - { tvID :: ItemID - -- ^ TheMovieDB unique ID. - - , tvName :: Text - -- ^ The name of the TV series. - - , tvOverview :: Text - -- ^ Short description of the TV series. - - , tvGenres :: [Genre] - -- ^ List of 'Genre's. - - , tvPopularity :: Double - -- ^ Popularity ranking. - - , tvPosterPath :: Text - -- ^ Incomplete URL for poster image. See 'tvPosterURLs'. - - , tvFirstAirDate :: Maybe Day - -- ^ Air date for first episode. - - , tvLastAirDate :: Maybe Day - -- ^ Air date for last episode. - - , tvNumberOfSeasons :: Int - -- ^ Number of seasons for the TV series. - - , tvNumberOfEpisodes :: Int - -- ^ Total number of episodes for all seasons. - - , tvSeasons :: [Season] - -- ^ Information about each season. + { -- | TheMovieDB unique ID. + tvID :: ItemID, + -- | The name of the TV series. + tvName :: Text, + -- | Short description of the TV series. + tvOverview :: Text, + -- | List of 'Genre's. + tvGenres :: [Genre], + -- | Popularity ranking. + tvPopularity :: Double, + -- | Incomplete URL for poster image. See 'tvPosterURLs'. + tvPosterPath :: Text, + -- | Air date for first episode. + tvFirstAirDate :: Maybe Day, + -- | Air date for last episode. + tvLastAirDate :: Maybe Day, + -- | Number of seasons for the TV series. + tvNumberOfSeasons :: Int, + -- | Total number of episodes for all seasons. + tvNumberOfEpisodes :: Int, + -- | Information about each season. -- -- The number of elements in this list may not match -- 'tvNumberOfSeasons'. Information about special episodes and -- unreleased episodes are usually kept in a 'Season' listed as -- season 0. Therefore, the first element in this list might not -- be season 1. - - } deriving (Eq, Show) + tvSeasons :: [Season] + } + deriving (Eq, Show) --------------------------------------------------------------------------------- instance Ord TV where compare a b = tvID a `compare` tvID b --------------------------------------------------------------------------------- instance FromJSON TV where - parseJSON (Object v) = - TV <$> v .: "id" - <*> v .: "name" - <*> v .:? "overview" .!= "" - <*> v .:? "genres" .!= [] - <*> v .:? "popularity" .!= 0.0 - <*> v .:? "poster_path" .!= "" - <*> v .:: "first_air_date" - <*> v .:: "last_air_date" - <*> v .:? "number_of_seasons" .!= 0 - <*> v .:? "number_of_episodes" .!= 0 - <*> v .:? "seasons" .!= [] - parseJSON v = typeMismatch "TV" v + parseJSON = withObject "TV" $ \v -> + TV + <$> v .: "id" + <*> v .: "name" + <*> v .:? "overview" .!= "" + <*> v .:? "genres" .!= [] + <*> v .:? "popularity" .!= 0.0 + <*> v .:? "poster_path" .!= "" + <*> v .:: "first_air_date" + <*> v .:: "last_air_date" + <*> v .:? "number_of_seasons" .!= 0 + <*> v .:? "number_of_episodes" .!= 0 + <*> v .:? "seasons" .!= [] --------------------------------------------------------------------------------- -- | Return a list of URLs for all possible TV posters. tvPosterURLs :: Configuration -> TV -> [Text] tvPosterURLs c m = posterURLs c (tvPosterPath m) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,15 +1,25 @@ --------------------------------------------------------------------------------- +-- | +-- +-- 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 Main (main) where --------------------------------------------------------------------------------- import qualified MovieTest as M import qualified TVTest as T import Test.Tasty --------------------------------------------------------------------------------- tests :: TestTree -tests = testGroup "Tests" [ M.tests, T.tests ] +tests = testGroup "Tests" [M.tests, T.tests] --------------------------------------------------------------------------------- main :: IO () main = defaultMain tests diff --git a/test/MovieTest.hs b/test/MovieTest.hs --- a/test/MovieTest.hs +++ b/test/MovieTest.hs @@ -1,41 +1,46 @@ -{-# LANGUAGE OverloadedStrings #-} - --------------------------------------------------------------------------------- +-- | +-- +-- 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 MovieTest (tests) where --------------------------------------------------------------------------------- +import qualified Data.Text as Text +import Network.API.TheMovieDB +import Network.API.TheMovieDB.Internal.HTTP (defaultImagePrefix) +import Network.API.TheMovieDB.Internal.TheMovieDB import Test.Tasty import Test.Tasty.HUnit import TestHelper --------------------------------------------------------------------------------- -import qualified Data.Text as T -import Network.API.TheMovieDB -import Network.API.TheMovieDB.Internal.TheMovieDB - --------------------------------------------------------------------------------- testSearchMovie :: Assertion testSearchMovie = do - movies <- fakeTMDB "test/search-good.json" (searchMovies T.empty) + movies <- fakeTMDB "test/search-good.json" (searchMovies mempty) assertEqual "length" 8 (length movies) --------------------------------------------------------------------------------- testMoviePosterURLs :: Assertion testMoviePosterURLs = do - cfg <- fakeTMDB "test/config-good.json" config + cfg <- fakeTMDB "test/config-good.json" config movie <- fakeTMDB "test/movie-good.json" (fetchMovie 0) let urls = moviePosterURLs cfg movie - poster = "http://cf2.imgobject.com/t/p/w92/pTpxQB1N0waaSc3OSn0e9oc8kx9.jpg" - assertEqual "length" 6 (length urls) - assertEqual "url" poster (head urls) + poster = defaultImagePrefix <> "w92/pTpxQB1N0waaSc3OSn0e9oc8kx9.jpg" + assertEqual "url" (Just poster) (viaNonEmpty head urls) --------------------------------------------------------------------------------- goodMovieFieldsTest :: Assertion goodMovieFieldsTest = do movie <- fakeTMDB "test/movie-good.json" (fetchMovie 0) assertEqual "movieID" 105 (movieID movie) assertEqual "movieTitle" "Back to the Future" (movieTitle movie) - assertBool "movieOverview" $ "Eighties teenager" `T.isPrefixOf` movieOverview movie + assertBool "movieOverview" $ "Eighties teenager" `Text.isPrefixOf` movieOverview movie assertEqual "movieGenres" 4 (length $ movieGenres movie) assertEqual "moviePopularity" 80329.688 $ moviePopularity movie assertEqual "moviePosterPath" "/pTpxQB1N0waaSc3OSn0e9oc8kx9.jpg" $ moviePosterPath movie @@ -44,30 +49,31 @@ assertEqual "movieIMDB" "tt0088763" $ movieIMDB movie assertEqual "movieRunTime" 116 $ movieRunTime movie --------------------------------------------------------------------------------- badMovieJSONTest :: Assertion badMovieJSONTest = do - result <- runTheMovieDBWithRequestFunction - (fileRequest "test/movie-bad.json") (fetchMovie 0) + result <- + runTheMovieDBWithRequestFunction + (fileRequest "test/movie-bad.json") + (fetchMovie 0) case result of Left (ResponseParseError _ _) -> return () - _ -> assertFailure "JSON should have been bad" + _ -> assertFailure "JSON should have been bad" --------------------------------------------------------------------------------- shouldHaveNetworkErrorTest :: Assertion shouldHaveNetworkErrorTest = do result <- runTheMovieDBWithRequestFunction fakeNetworkError (fetchMovie 0) case result of Left (ServiceError _) -> return () - _ -> assertFailure "should have network error" + _ -> assertFailure "should have network error" --------------------------------------------------------------------------------- tests :: TestTree -tests = testGroup "Movies" - [ testCase "All movie fields are parsed" goodMovieFieldsTest - , testCase "Failure with bad JSON" badMovieJSONTest - , testCase "Propagate network failure" shouldHaveNetworkErrorTest - , testCase "Searching movies" testSearchMovie - , testCase "Movie poster URLs" testMoviePosterURLs - ] +tests = + testGroup + "Movies" + [ testCase "All movie fields are parsed" goodMovieFieldsTest, + testCase "Failure with bad JSON" badMovieJSONTest, + testCase "Propagate network failure" shouldHaveNetworkErrorTest, + testCase "Searching movies" testSearchMovie, + testCase "Movie poster URLs" testMoviePosterURLs + ] diff --git a/test/TVTest.hs b/test/TVTest.hs --- a/test/TVTest.hs +++ b/test/TVTest.hs @@ -1,78 +1,79 @@ -{-# LANGUAGE OverloadedStrings #-} - --------------------------------------------------------------------------------- +-- | +-- +-- 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 TVTest (tests) where --------------------------------------------------------------------------------- +import Network.API.TheMovieDB +import Network.API.TheMovieDB.Internal.HTTP (defaultImagePrefix) import Test.Tasty import Test.Tasty.HUnit import TestHelper --------------------------------------------------------------------------------- -import qualified Data.Text as T -import Network.API.TheMovieDB - --------------------------------------------------------------------------------- testTVBasicFields :: TV -> Assertion testTVBasicFields tv = do - assertEqual "id" 1437 (tvID tv) - assertEqual "name" "Firefly" (tvName tv) + assertEqual "id" 1437 (tvID tv) + assertEqual "name" "Firefly" (tvName tv) assertEqual "poster" "/mWNadwBZIx8NyEw4smGftYtHHrE.jpg" (tvPosterPath tv) - assertEqual "aired" (mkDay 2002 12 20) (tvFirstAirDate tv) + assertEqual "aired" (mkDay 2002 12 20) (tvFirstAirDate tv) --------------------------------------------------------------------------------- testSearchTV :: Assertion testSearchTV = do - tvs <- fakeTMDB "test/search-tv-good.json" (searchTV T.empty) + tvs <- fakeTMDB "test/search-tv-good.json" (searchTV mempty) assertEqual "length" 1 (length tvs) mapM_ testTVBasicFields tvs --------------------------------------------------------------------------------- testFetchTV :: Assertion testFetchTV = do tv <- fakeTMDB "test/tv-good.json" (fetchTV 0) testTVBasicFields tv - assertEqual "genres" 2 (length $ tvGenres tv) - assertEqual "seasons" 1 (tvNumberOfSeasons tv) - assertEqual "episodes" 13 (tvNumberOfEpisodes tv) - assertEqual "season len" 2 (length $ tvSeasons tv) + assertEqual "genres" 2 (length $ tvGenres tv) + assertEqual "seasons" 1 (tvNumberOfSeasons tv) + assertEqual "episodes" 13 (tvNumberOfEpisodes tv) + assertEqual "season len" 2 (length $ tvSeasons tv) --------------------------------------------------------------------------------- testFetchSeason :: Assertion testFetchSeason = do season <- fakeTMDB "test/season-good.json" (fetchTVSeason 0 0) assertEqual "length" 14 (length $ seasonEpisodes season) --------------------------------------------------------------------------------- testSeasonPoster :: Assertion testSeasonPoster = do - cfg <- fakeTMDB "test/config-good.json" config + cfg <- fakeTMDB "test/config-good.json" config season <- fakeTMDB "test/season-good.json" (fetchTVSeason 0 0) - let expect = "http://cf2.imgobject.com/t/p/w92/2dxsbVMoxsYH0Pta2mbFjF7mhHr.jpg" - urls = seasonPosterURLs cfg season + let expect = defaultImagePrefix <> "w92/2dxsbVMoxsYH0Pta2mbFjF7mhHr.jpg" + urls = seasonPosterURLs cfg season - assertEqual "length" 6 (length urls) - assertEqual "poster" expect (head urls) + assertEqual "poster" (Just expect) (viaNonEmpty head urls) --------------------------------------------------------------------------------- testTVPoster :: Assertion testTVPoster = do cfg <- fakeTMDB "test/config-good.json" config - tv <- fakeTMDB "test/tv-good.json" (fetchTV 0) + tv <- fakeTMDB "test/tv-good.json" (fetchTV 0) - let expect = "http://cf2.imgobject.com/t/p/w92/mWNadwBZIx8NyEw4smGftYtHHrE.jpg" - urls = tvPosterURLs cfg tv + let expect = defaultImagePrefix <> "w92/mWNadwBZIx8NyEw4smGftYtHHrE.jpg" + urls = tvPosterURLs cfg tv - assertEqual "length" 6 (length urls) - assertEqual "poster" expect (head urls) + assertEqual "poster" (Just expect) (viaNonEmpty head urls) --------------------------------------------------------------------------------- tests :: TestTree -tests = testGroup "TV" - [ testCase "Search fields" testSearchTV - , testCase "Fetch fields" testFetchTV - , testCase "Season fields" testFetchSeason - , testCase "Season Poster" testSeasonPoster - , testCase "TV Poster" testTVPoster - ] +tests = + testGroup + "TV" + [ testCase "Search fields" testSearchTV, + testCase "Fetch fields" testFetchTV, + testCase "Season fields" testFetchSeason, + testCase "Season Poster" testSeasonPoster, + testCase "TV Poster" testTVPoster + ] diff --git a/test/TestHelper.hs b/test/TestHelper.hs --- a/test/TestHelper.hs +++ b/test/TestHelper.hs @@ -1,42 +1,43 @@ --------------------------------------------------------------------------------- +-- | +-- +-- 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 TestHelper - ( fakeTMDB - , fileRequest - , fakeNetworkError - , mkDay - ) where + ( fakeTMDB, + fileRequest, + fakeNetworkError, + mkDay, + ) +where --------------------------------------------------------------------------------- -import Control.Applicative -import qualified Data.ByteString.Lazy as B import Data.Time (Day (..), fromGregorian) import Network.API.TheMovieDB.Internal.TheMovieDB import Network.API.TheMovieDB.Internal.Types import Test.Tasty.HUnit --------------------------------------------------------------------------------- --- The following is a kludge to avoid the "redundant import" warning --- when using GHC >= 7.10.x. This should be removed after we decide --- to stop supporting GHC < 7.10.x. -import Prelude - --------------------------------------------------------------------------------- fakeTMDB :: FilePath -> TheMovieDB a -> IO a fakeTMDB path m = do result <- runTheMovieDBWithRequestFunction (fileRequest path) m case result of - Left e -> assertFailure (show e) >> fail (show e) + Left e -> assertFailure (show e) >> fail (show e) Right a -> return a --------------------------------------------------------------------------------- fileRequest :: FilePath -> RequestFunction -fileRequest path _ _ = Right <$> B.readFile path +fileRequest path _ _ = Right <$> readFileLBS path --------------------------------------------------------------------------------- fakeNetworkError :: RequestFunction fakeNetworkError _ _ = return $ Left $ ServiceError "fake outage" --------------------------------------------------------------------------------- mkDay :: Integer -> Int -> Int -> Maybe Day mkDay y m d = Just (fromGregorian y m d) diff --git a/test/config-good.json b/test/config-good.json --- a/test/config-good.json +++ b/test/config-good.json @@ -1,1 +1,1 @@ -{"images":{"base_url":"http://cf2.imgobject.com/t/p/","secure_base_url":"https://d1zm4mmpsrckwj.cloudfront.net/t/p/","poster_sizes":["w92","w154","w185","w342","w500","original"],"backdrop_sizes":["w300","w780","w1280","original"],"profile_sizes":["w45","w185","h632","original"],"logo_sizes":["w45","w92","w154","w185","w300","w500","original"]},"change_keys":["adult","also_known_as","alternative_titles","biography","birthday","budget","cast","character_names","crew","deathday","general","genres","homepage","images","imdb_id","name","original_title","overview","plot_keywords","production_companies","production_countries","releases","revenue","runtime","spoken_languages","status","tagline","title","trailers","translations"]} +{"images":{"base_url":"http://image.tmdb.org/t/p/","secure_base_url":"https://image.tmdb.org/t/p/","backdrop_sizes":["w300","w780","w1280","original"],"logo_sizes":["w45","w92","w154","w185","w300","w500","original"],"poster_sizes":["w92","w154","w185","w342","w500","w780","original"],"profile_sizes":["w45","w185","h632","original"],"still_sizes":["w92","w185","w300","original"]},"change_keys":["adult","air_date","also_known_as","alternative_titles","biography","birthday","budget","cast","certifications","character_names","created_by","crew","deathday","episode","episode_number","episode_run_time","freebase_id","freebase_mid","general","genres","guest_stars","homepage","images","imdb_id","languages","name","network","origin_country","original_name","original_title","overview","parts","place_of_birth","plot_keywords","production_code","production_companies","production_countries","releases","revenue","runtime","season","season_number","season_regular","spoken_languages","status","tagline","title","translations","tvdb_id","tvrage_id","type","video","videos"]} diff --git a/themoviedb.cabal b/themoviedb.cabal --- a/themoviedb.cabal +++ b/themoviedb.cabal @@ -1,21 +1,22 @@ --------------------------------------------------------------------------------- -name: themoviedb -version: 1.1.5.2 -synopsis: Haskell API bindings for http://themoviedb.org -homepage: https://code.devalot.com/open/themoviedb -bug-reports: https://code.devalot.com/open/themoviedb/issues -license: MIT -license-file: LICENSE -author: Peter Jones -maintainer: Peter Jones -copyright: Copyright: (c) 2012-2019 Peter Jones -category: Network, API -stability: experimental -build-type: Simple -cabal-version: 1.18 -description: This library provides functions for retrieving metadata - from the API. Documentation - can be found in the "Network.API.TheMovieDB" module. +cabal-version: 2.2 +name: themoviedb +version: 1.2.0.0 +synopsis: Haskell API bindings for http://themoviedb.org +homepage: https://github.com/pjones/themoviedb +bug-reports: https://github.com/pjones/themoviedb/issues +license: MIT +license-file: LICENSE +author: Peter Jones +maintainer: Peter Jones +copyright: Copyright: (c) 2012-2020 Peter Jones +category: Network, API +stability: stable +build-type: Simple +tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.1 +description: + This library provides functions for retrieving metadata + from the API. Documentation + can be found in the "Network.API.TheMovieDB" module. -------------------------------------------------------------------------------- extra-source-files: @@ -26,17 +27,61 @@ -------------------------------------------------------------------------------- source-repository head - type: git - location: https://code.devalot.com/open/themoviedb.git + type: git + location: https://github.com/pjones/themoviedb.git -------------------------------------------------------------------------------- flag maintainer description: Enable settings for the package maintainer. - manual: True - default: False + manual: True + default: False -------------------------------------------------------------------------------- +common options + default-language: Haskell2010 + ghc-options: + -Wall -Wno-name-shadowing -Werror=incomplete-record-updates + -Werror=incomplete-uni-patterns -Werror=missing-home-modules + -Widentities -Wmissing-export-lists -Wredundant-constraints + + if flag(maintainer) + ghc-options: -Werror + +-------------------------------------------------------------------------------- +common extensions + default-extensions: + DeriveAnyClass + DeriveGeneric + DerivingStrategies + GeneralizedNewtypeDeriving + LambdaCase + MultiParamTypeClasses + OverloadedStrings + RecordWildCards + ScopedTypeVariables + TupleSections + +-------------------------------------------------------------------------------- +common dependencies + build-depends: + , aeson >=1.0 && <1.6 + , base >=4.6 && <5.0 + , http-client >=0.4.31 && <0.8 + , http-client-tls >=0.2.2 && <0.4 + , http-types >=0.8 && <0.13 + , mtl >=2.1 && <2.3 + , relude >=0.6 && <0.8 + , text >=0.11 && <1.3 + , time >=1.5 && <1.11 + + mixins: + base hiding (Prelude), + relude (Relude as Prelude) + +-------------------------------------------------------------------------------- library + import: options, extensions, dependencies + hs-source-dirs: src exposed-modules: Network.API.TheMovieDB Network.API.TheMovieDB.Actions @@ -44,6 +89,7 @@ Network.API.TheMovieDB.Internal.Date Network.API.TheMovieDB.Internal.HTTP Network.API.TheMovieDB.Internal.SearchResults + Network.API.TheMovieDB.Internal.Settings Network.API.TheMovieDB.Internal.TheMovieDB Network.API.TheMovieDB.Internal.Types Network.API.TheMovieDB.Types.Episode @@ -52,63 +98,25 @@ Network.API.TheMovieDB.Types.Season Network.API.TheMovieDB.Types.TV - default-language: Haskell2010 - hs-source-dirs: src - ghc-options: -Wall -fwarn-incomplete-uni-patterns - - if flag(maintainer) - ghc-options: -Werror - - build-depends: aeson >= 0.6 && < 1.5 - , base >= 4.6 && < 5.0 - , binary >= 0.7 && < 0.11 - , bytestring >= 0.9 && < 0.11 - , http-client >= 0.4.31 && < 0.7 - , http-client-tls >= 0.2.2 && < 0.4 - , http-types >= 0.8 && < 0.13 - , mtl >= 2.1 && < 2.3 - , text >= 0.11 && < 1.3 - , text-binary >= 0.1 && < 0.3 - , time >= 1.5 && < 1.10 - , time-locale-compat >= 0.1 && < 0.2 - , transformers >= 0.3 && < 0.6 - -------------------------------------------------------------------------------- executable tmdb - default-language: Haskell2010 + import: options, extensions, dependencies hs-source-dirs: example - main-is: Main.hs - - ghc-options: -Wall -fwarn-incomplete-uni-patterns - - if flag(maintainer) - ghc-options: -Werror - ghc-prof-options: -auto-all - - build-depends: base - , text - , themoviedb - , time - , time-locale-compat - , transformers + main-is: Main.hs + build-depends: themoviedb -------------------------------------------------------------------------------- test-suite test - type: exitcode-stdio-1.0 - default-language: Haskell2010 + import: options, extensions, dependencies + type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Main.hs - other-modules: TestHelper MovieTest TVTest - - ghc-options: -Wall -fwarn-incomplete-uni-patterns - - if flag(maintainer) - ghc-options: -Werror + main-is: Main.hs + other-modules: + MovieTest + TestHelper + TVTest - build-depends: base - , bytestring - , tasty >= 0.10 && < 1.3 - , tasty-hunit >= 0.9 && < 0.11 - , text - , themoviedb - , time + build-depends: + , tasty >=0.10 && <1.3 + , tasty-hunit >=0.9 && <0.11 + , themoviedb