Browse Source

Clean things up, add docs and a few instances

tags/v0.2.2.0
Peter J. Jones 4 years ago
parent
commit
ed9daa463e

+ 8
- 7
example/Main.hs View File

@@ -1,3 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}

{-

This file is part of the Haskell package themoviedb. It is subject to
@@ -14,7 +16,6 @@ module Main (main) where

--------------------------------------------------------------------------------
import Control.Monad.IO.Class (liftIO)
import Data.List (intercalate)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -29,7 +30,7 @@ import Text.Printf (printf)
-- | Simple banner style printing of a 'Movie'.
printMovieHeader :: Movie -> IO ()
printMovieHeader m =
printf "%8d: %s (%s)\n" (movieID m) (movieTitle m) year
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 -> "----"
@@ -41,14 +42,14 @@ printMovieDetails m =
do putStrLn $ "Popularity: " ++ show (moviePopularity m)
putStrLn $ strJoin $ map genreName (movieGenres m)
putStrLn "-- "
putStrLn $ movieOverview m
where strJoin = intercalate ", "
putStrLn $ T.unpack (movieOverview m)
where strJoin = T.unpack . T.intercalate ", "

--------------------------------------------------------------------------------
-- | Search for movies with a query string.
searchAndListMovies :: Text -> TheMovieDB ()
searchAndListMovies query = do
movies <- search query
movies <- searchMovies query
liftIO $ mapM_ printMovieHeader movies

--------------------------------------------------------------------------------
@@ -56,11 +57,11 @@ searchAndListMovies query = do
fetchAndPrintMovie :: MovieID -> TheMovieDB ()
fetchAndPrintMovie mid = do
cfg <- config
movie <- fetch mid
movie <- fetchMovie mid

liftIO $ do
printMovieHeader movie
mapM_ putStrLn (moviePosterURLs cfg movie)
mapM_ (putStrLn . T.unpack) (moviePosterURLs cfg movie)
printMovieDetails movie

--------------------------------------------------------------------------------

+ 23
- 7
src/Network/API/TheMovieDB.hs View File

@@ -15,24 +15,41 @@ This library provides some data types and functions for fetching movie
metadata from <http://TheMovieDB.org>. To use this library start by
requesting an API key from <http://docs.themoviedb.apiary.io>.

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.
-}
module Network.API.TheMovieDB
( -- * Types
Movie(..)
MovieID
, Movie(..)
, GenreID
, Genre(..)
, Error(..)
, Key
, MovieID
, GenreID

-- * API Functions
, TheMovieDB
, runTheMovieDB
, runTheMovieDBWithManager
, fetch
, search
, fetchMovie
, searchMovies

-- * Utility Types and Functions
, Configuration
@@ -41,5 +58,4 @@ module Network.API.TheMovieDB
) where

import Network.API.TheMovieDB.Types
import Network.API.TheMovieDB.Config
import Network.API.TheMovieDB.Action
import Network.API.TheMovieDB.Actions

src/Network/API/TheMovieDB/Action.hs → src/Network/API/TheMovieDB/Actions.hs View File

@@ -12,9 +12,10 @@ contained in the LICENSE file.
-}

--------------------------------------------------------------------------------
module Network.API.TheMovieDB.Action
( fetch
, search
module Network.API.TheMovieDB.Actions
( fetchMovie
, searchMovies
, config
) where

--------------------------------------------------------------------------------
@@ -26,8 +27,8 @@ import Network.API.TheMovieDB.Types

--------------------------------------------------------------------------------
-- | Fetch the metadata for the movie with the given ID.
fetch :: MovieID -> TheMovieDB Movie
fetch mid = getAndParse ("movie/" ++ show mid) []
fetchMovie :: MovieID -> TheMovieDB Movie
fetchMovie mid = getAndParse ("movie/" ++ show mid) []

--------------------------------------------------------------------------------
-- | Internal function to translate search results to a list of movies.
@@ -40,5 +41,12 @@ fetchSearchResults query = getAndParse "search/movie" [("query", Just query)]
-- 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 'fetch'.
search :: Text -> TheMovieDB [Movie]
search query = searchResults <$> fetchSearchResults query
searchMovies :: Text -> TheMovieDB [Movie]
searchMovies query = searchResults <$> fetchSearchResults query

--------------------------------------------------------------------------------
-- | 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 = getAndParse "configuration" []

+ 0
- 23
src/Network/API/TheMovieDB/Config.hs View File

@@ -1,25 +0,0 @@
{-

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.

-}

--------------------------------------------------------------------------------
module Network.API.TheMovieDB.Config
( config
) where

--------------------------------------------------------------------------------
import Network.API.TheMovieDB.Internal.TheMovieDB
import Network.API.TheMovieDB.Types

--------------------------------------------------------------------------------
config :: TheMovieDB Configuration
config = getAndParse "configuration" []

+ 28
- 5
src/Network/API/TheMovieDB/Internal/Configuration.hs View File

@@ -1,4 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

{-

@@ -20,6 +20,10 @@ module Network.API.TheMovieDB.Internal.Configuration
--------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Binary
import Data.Text (Text)
import Data.Text.Binary ()
import GHC.Generics (Generic)

--------------------------------------------------------------------------------
-- | TheMovieDB API tries to preserve bandwidth by omitting
@@ -30,11 +34,22 @@ import Data.Aeson
--
-- A helper function is provided ('moviePosterURLs') that constructs a
-- list of all poster URLs given a 'Movie' and 'Configuration'.
--
-- According to the API documentation for TheMovieDB, you should cache
-- the 'Configuration' value and only request it every few days.
-- 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 :: String -- ^ The base URL for images.
, cfgImageSecBaseURL :: String -- ^ Base URL for secure images.
, cfgPosterSizes :: [String] -- ^ List of possible image sizes.
}
{ 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

--------------------------------------------------------------------------------
instance FromJSON Configuration where
@@ -45,3 +60,11 @@ instance FromJSON Configuration where
where images key = (v .: "images") >>= (.: key)
imagesM key def = (v .: "images") >>= (\x -> x .:? key .!= def)
parseJSON _ = empty

--------------------------------------------------------------------------------
instance ToJSON Configuration where
toJSON c = object [ "images" .= object
[ "base_url" .= cfgImageBaseURL c
, "secure_base_url" .= cfgImageSecBaseURL c
, "poster_sizes" .= cfgPosterSizes c
]]

+ 4
- 0
src/Network/API/TheMovieDB/Internal/ReleaseDate.hs View File

@@ -12,6 +12,7 @@ contained in the LICENSE file.
-}

--------------------------------------------------------------------------------
-- | Utility type for working with release dates.
module Network.API.TheMovieDB.Internal.ReleaseDate
( ReleaseDate (..)
) where
@@ -24,12 +25,13 @@ import Data.Time (parseTime, Day(..))
import System.Locale (defaultTimeLocale)

--------------------------------------------------------------------------------
-- | A simple type wrapper around 'Day' in order to parse a movie's
-- release date, which may be null or empty.
newtype ReleaseDate = ReleaseDate
{releaseDate :: Maybe Day} deriving (Eq, Show)

--------------------------------------------------------------------------------
-- | Parse release dates in JSON.
instance FromJSON ReleaseDate where
parseJSON (Null) = return (ReleaseDate Nothing)
parseJSON (String t)

+ 2
- 0
src/Network/API/TheMovieDB/Internal/SearchResults.hs View File

@@ -12,6 +12,7 @@ contained in the LICENSE file.
-}

--------------------------------------------------------------------------------
-- | Utility type for processing movie search results.
module Network.API.TheMovieDB.Internal.SearchResults
( SearchResults (..)
) where
@@ -22,7 +23,7 @@ import Data.Aeson
import Network.API.TheMovieDB.Types

--------------------------------------------------------------------------------
-- | Internal wrapper to parse a list of movies from JSON.
newtype SearchResults = SearchResults {searchResults :: [Movie]}
deriving (Eq, Show)


+ 6
- 0
src/Network/API/TheMovieDB/Internal/Types.hs View File

@@ -10,6 +10,8 @@ contained in the LICENSE file.
-}

--------------------------------------------------------------------------------
-- | Simple types and synonyms, mostly to make the type signatures
-- easier to read.
module Network.API.TheMovieDB.Internal.Types
( Key
, Body
@@ -27,8 +29,11 @@ import Network.HTTP.Client (HttpException)
type Key = Text

--------------------------------------------------------------------------------
-- | URL path.
type Path = String
--------------------------------------------------------------------------------
-- | HTTP body.
type Body = ByteString

--------------------------------------------------------------------------------

+ 2
- 1
src/Network/API/TheMovieDB/Types/Genre.hs View File

@@ -21,6 +21,7 @@ module Network.API.TheMovieDB.Types.Genre
import Control.Applicative
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
import Data.Text (Text)

--------------------------------------------------------------------------------
-- | Type for representing unique genre IDs.
@@ -30,7 +31,7 @@ type GenreID = Int
-- | Metadata for a genre.
data Genre = Genre
{ genreID :: GenreID -- ^ TheMovieDB unique ID.
, genreName :: String -- ^ The name of the genre.
, genreName :: Text -- ^ The name of the genre.
} deriving (Eq, Show)

--------------------------------------------------------------------------------

+ 8
- 6
src/Network/API/TheMovieDB/Types/Movie.hs View File

@@ -21,6 +21,8 @@ module Network.API.TheMovieDB.Types.Movie
--------------------------------------------------------------------------------
import Control.Applicative
import Data.Aeson
import Data.Monoid
import Data.Text (Text)
import Data.Time (Day (..))
import Network.API.TheMovieDB.Internal.Configuration
import Network.API.TheMovieDB.Internal.ReleaseDate
@@ -40,10 +42,10 @@ data Movie = Movie
{ movieID :: MovieID
-- ^ TheMovieDB unique ID.

, movieTitle :: String
, movieTitle :: Text
-- ^ The name/title of the movie.

, movieOverview :: String
, movieOverview :: Text
-- ^ Short plot summary.

, movieGenres :: [Genre]
@@ -52,7 +54,7 @@ data Movie = Movie
, moviePopularity :: Double
-- ^ Popularity ranking.

, moviePosterPath :: String
, moviePosterPath :: Text
-- ^ Incomplete URL for poster image. See 'moviePosterURLs'.

, movieReleaseDate :: Maybe Day
@@ -61,7 +63,7 @@ data Movie = Movie
, movieAdult :: Bool
-- ^ TheMovieDB adult movie flag.

, movieIMDB :: String
, movieIMDB :: Text
-- ^ IMDB.com ID.

, movieRunTime :: Int
@@ -86,7 +88,7 @@ instance FromJSON Movie where

--------------------------------------------------------------------------------
-- | Return a list of URLs for all possible movie posters.
moviePosterURLs :: Configuration -> Movie -> [String]
moviePosterURLs c m = [base ++ size ++ poster | size <- cfgPosterSizes c]
moviePosterURLs :: Configuration -> Movie -> [Text]
moviePosterURLs c m = [base <> size <> poster | size <- cfgPosterSizes c]
where base = cfgImageBaseURL c
poster = moviePosterPath m

+ 10
- 8
test/Main.hs View File

@@ -1,17 +1,19 @@
{-# LANGUAGE OverloadedStrings #-}

--------------------------------------------------------------------------------
module Main (main) where

--------------------------------------------------------------------------------
-- http://www.haskell.org/haskellwiki/HUnit_1.0_User%27s_Guide
import Control.Monad.IO.Class (liftIO)
import Control.Monad (liftM, when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Text as T
import Data.Time (fromGregorian)
import Network.API.TheMovieDB
import Network.API.TheMovieDB.Internal.Types
import Network.API.TheMovieDB.Internal.TheMovieDB
import Network.API.TheMovieDB.Internal.Types
import System.Exit (exitFailure)
import Data.List (isPrefixOf)
import Data.Time (fromGregorian)

--------------------------------------------------------------------------------
import Test.HUnit
@@ -35,14 +37,14 @@ fakeNetworkError _ _ = return $ Left $ ServiceError "fake outage"

--------------------------------------------------------------------------------
goodMovieFieldsTest = TestCase $ do
result <- runTheMovieDBWithRequestFunction loadGoodMovieFile (fetch 0)
result <- runTheMovieDBWithRequestFunction loadGoodMovieFile (fetchMovie 0)
case result of
Left err -> assertFailure $ show err
Right movie -> do
assertEqual "movieID" 105 (movieID movie)
assertEqual "movieTitle" "Back to the Future" (movieTitle movie)
assertBool "movieOverview" $
"Eighties teenager" `isPrefixOf` movieOverview movie
"Eighties teenager" `T.isPrefixOf` movieOverview movie
assertEqual "movieGenres" 4 (length $ movieGenres movie)
assertEqual "moviePopularity" 80329.688 $ moviePopularity movie
assertEqual "moviePosterPath" "/pTpxQB1N0waaSc3OSn0e9oc8kx9.jpg" $
@@ -55,14 +57,14 @@ goodMovieFieldsTest = TestCase $ do

--------------------------------------------------------------------------------
badMovieJSONTest = TestCase $ do
result <- runTheMovieDBWithRequestFunction loadBadMovieFile (fetch 0)
result <- runTheMovieDBWithRequestFunction loadBadMovieFile (fetchMovie 0)
case result of
Left (ResponseParseError e _) -> return ()
_ -> assertFailure "JSON should have been bad"

--------------------------------------------------------------------------------
shouldHaveNetworkErrorTest = TestCase $ do
result <- runTheMovieDBWithRequestFunction fakeNetworkError (fetch 0)
result <- runTheMovieDBWithRequestFunction fakeNetworkError (fetchMovie 0)
case result of
Left (ServiceError e) -> return ()
_ -> assertFailure "should have network error"

+ 3
- 2
themoviedb.cabal View File

@@ -40,8 +40,7 @@ flag maintainer
library
exposed-modules:
Network.API.TheMovieDB
Network.API.TheMovieDB.Action
Network.API.TheMovieDB.Config
Network.API.TheMovieDB.Actions
Network.API.TheMovieDB.Internal.Configuration
Network.API.TheMovieDB.Internal.HTTP
Network.API.TheMovieDB.Internal.ReleaseDate
@@ -62,6 +61,7 @@ library

build-depends: aeson >= 0.6 && < 0.9
, base >= 4.6 && < 5.0
, binary >= 0.7 && < 0.8
, bytestring >= 0.9 && < 0.11
, either >= 4.3 && < 4.4
, http-client >= 0.4 && < 0.5
@@ -72,6 +72,7 @@ library
, network-uri >= 2.6 && < 2.7
, old-locale >= 1.0 && < 1.1
, text >= 0.11 && < 1.3
, text-binary >= 0.1 && < 0.2
, time >= 1.2 && < 1.6
, transformers >= 0.3 && < 0.5
, unix >= 2.5 && < 2.8

Loading…
Cancel
Save