-- |
--
-- 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

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 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
  {TheMovieDB a -> ReaderT RequestFunction (ExceptT Error IO) a
unTMDB :: ReaderT RequestFunction (ExceptT Error IO) a}
  deriving newtype (a -> TheMovieDB b -> TheMovieDB a
(a -> b) -> TheMovieDB a -> TheMovieDB b
(forall a b. (a -> b) -> TheMovieDB a -> TheMovieDB b)
-> (forall a b. a -> TheMovieDB b -> TheMovieDB a)
-> Functor TheMovieDB
forall a b. a -> TheMovieDB b -> TheMovieDB a
forall a b. (a -> b) -> TheMovieDB a -> TheMovieDB b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TheMovieDB b -> TheMovieDB a
$c<$ :: forall a b. a -> TheMovieDB b -> TheMovieDB a
fmap :: (a -> b) -> TheMovieDB a -> TheMovieDB b
$cfmap :: forall a b. (a -> b) -> TheMovieDB a -> TheMovieDB b
Functor, Functor TheMovieDB
a -> TheMovieDB a
Functor TheMovieDB
-> (forall a. a -> TheMovieDB a)
-> (forall a b.
    TheMovieDB (a -> b) -> TheMovieDB a -> TheMovieDB b)
-> (forall a b c.
    (a -> b -> c) -> TheMovieDB a -> TheMovieDB b -> TheMovieDB c)
-> (forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b)
-> (forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB a)
-> Applicative TheMovieDB
TheMovieDB a -> TheMovieDB b -> TheMovieDB b
TheMovieDB a -> TheMovieDB b -> TheMovieDB a
TheMovieDB (a -> b) -> TheMovieDB a -> TheMovieDB b
(a -> b -> c) -> TheMovieDB a -> TheMovieDB b -> TheMovieDB c
forall a. a -> TheMovieDB a
forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB a
forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b
forall a b. TheMovieDB (a -> b) -> TheMovieDB a -> TheMovieDB b
forall a b c.
(a -> b -> c) -> TheMovieDB a -> TheMovieDB b -> TheMovieDB c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TheMovieDB a -> TheMovieDB b -> TheMovieDB a
$c<* :: forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB a
*> :: TheMovieDB a -> TheMovieDB b -> TheMovieDB b
$c*> :: forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b
liftA2 :: (a -> b -> c) -> TheMovieDB a -> TheMovieDB b -> TheMovieDB c
$cliftA2 :: forall a b c.
(a -> b -> c) -> TheMovieDB a -> TheMovieDB b -> TheMovieDB c
<*> :: TheMovieDB (a -> b) -> TheMovieDB a -> TheMovieDB b
$c<*> :: forall a b. TheMovieDB (a -> b) -> TheMovieDB a -> TheMovieDB b
pure :: a -> TheMovieDB a
$cpure :: forall a. a -> TheMovieDB a
$cp1Applicative :: Functor TheMovieDB
Applicative, Applicative TheMovieDB
a -> TheMovieDB a
Applicative TheMovieDB
-> (forall a b.
    TheMovieDB a -> (a -> TheMovieDB b) -> TheMovieDB b)
-> (forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b)
-> (forall a. a -> TheMovieDB a)
-> Monad TheMovieDB
TheMovieDB a -> (a -> TheMovieDB b) -> TheMovieDB b
TheMovieDB a -> TheMovieDB b -> TheMovieDB b
forall a. a -> TheMovieDB a
forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b
forall a b. TheMovieDB a -> (a -> TheMovieDB b) -> TheMovieDB b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TheMovieDB a
$creturn :: forall a. a -> TheMovieDB a
>> :: TheMovieDB a -> TheMovieDB b -> TheMovieDB b
$c>> :: forall a b. TheMovieDB a -> TheMovieDB b -> TheMovieDB b
>>= :: TheMovieDB a -> (a -> TheMovieDB b) -> TheMovieDB b
$c>>= :: forall a b. TheMovieDB a -> (a -> TheMovieDB b) -> TheMovieDB b
$cp1Monad :: Applicative TheMovieDB
Monad, Monad TheMovieDB
Monad TheMovieDB
-> (forall a. IO a -> TheMovieDB a) -> MonadIO TheMovieDB
IO a -> TheMovieDB a
forall a. IO a -> TheMovieDB a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> TheMovieDB a
$cliftIO :: forall a. IO a -> TheMovieDB a
$cp1MonadIO :: Monad TheMovieDB
MonadIO)

-- | Helper function for making a request using the request function
-- stashed away in the reader monad.
runRequest :: Path -> QueryText -> TheMovieDB Body
runRequest :: Path -> QueryText -> TheMovieDB Body
runRequest Path
path QueryText
params = ReaderT RequestFunction (ExceptT Error IO) Body -> TheMovieDB Body
forall a.
ReaderT RequestFunction (ExceptT Error IO) a -> TheMovieDB a
TheMovieDB (ReaderT RequestFunction (ExceptT Error IO) Body
 -> TheMovieDB Body)
-> ReaderT RequestFunction (ExceptT Error IO) Body
-> TheMovieDB Body
forall a b. (a -> b) -> a -> b
$ do
  RequestFunction
func <- ReaderT RequestFunction (ExceptT Error IO) RequestFunction
forall r (m :: * -> *). MonadReader r m => m r
ask
  ExceptT Error IO Body
-> ReaderT RequestFunction (ExceptT Error IO) Body
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Either Error Body) -> ExceptT Error IO Body
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Error Body) -> ExceptT Error IO Body)
-> IO (Either Error Body) -> ExceptT Error IO Body
forall a b. (a -> b) -> a -> b
$ IO (Either Error Body) -> IO (Either Error Body)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (RequestFunction
func Path
path QueryText
params))

-- | Helper function to preform an HTTP GET and decode the JSON result.
getAndParse :: FromJSON a => Path -> QueryText -> TheMovieDB a
getAndParse :: Path -> QueryText -> TheMovieDB a
getAndParse Path
path QueryText
params = do
  Body
body <- Path -> QueryText -> TheMovieDB Body
runRequest Path
path QueryText
params

  case Body -> Either Path a
forall a. FromJSON a => Body -> Either Path a
eitherDecode Body
body of
    Left Path
e -> Error -> TheMovieDB a
forall a. Error -> TheMovieDB a
tmdbError (Error -> TheMovieDB a) -> Error -> TheMovieDB a
forall a b. (a -> b) -> a -> b
$ Path -> Maybe Body -> Error
ResponseParseError (Path
"bad JSON: " Path -> Path -> Path
forall a. [a] -> [a] -> [a]
++ Path
e) (Body -> Maybe Body
forall a. a -> Maybe a
Just Body
body)
    Right a
a -> a -> TheMovieDB a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Create a 'TheMovieDB' value representing an error.
tmdbError :: Error -> TheMovieDB a
tmdbError :: Error -> TheMovieDB a
tmdbError = ReaderT RequestFunction (ExceptT Error IO) a -> TheMovieDB a
forall a.
ReaderT RequestFunction (ExceptT Error IO) a -> TheMovieDB a
TheMovieDB (ReaderT RequestFunction (ExceptT Error IO) a -> TheMovieDB a)
-> (Error -> ReaderT RequestFunction (ExceptT Error IO) a)
-> Error
-> TheMovieDB a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> ReaderT RequestFunction (ExceptT Error IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
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 ::
  -- | Library settings.
  Settings ->
  -- | The API calls to make.
  TheMovieDB a ->
  -- | Response or error.
  IO (Either Error a)
runTheMovieDB :: Settings -> TheMovieDB a -> IO (Either Error a)
runTheMovieDB Settings
s TheMovieDB a
t = do
  Manager
m <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
forall a.
Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
runTheMovieDBWithManager Manager
m Settings
s TheMovieDB a
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 ::
  -- | The 'Manager' to use.
  Manager ->
  -- | Library settings.
  Settings ->
  -- | The API calls to make.
  TheMovieDB a ->
  -- | Response or error.
  IO (Either Error a)
runTheMovieDBWithManager :: Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
runTheMovieDBWithManager Manager
m Settings
s = RequestFunction -> TheMovieDB a -> IO (Either Error a)
forall a. RequestFunction -> TheMovieDB a -> IO (Either Error a)
runTheMovieDBWithRequestFunction (Manager -> Settings -> RequestFunction
apiGET Manager
m Settings
s)

-- | Low-level interface for executing a 'TheMovieDB' using the given
-- request function.
runTheMovieDBWithRequestFunction ::
  -- | The request function to use.
  RequestFunction ->
  -- | The API calls to make.
  TheMovieDB a ->
  -- | Response.
  IO (Either Error a)
runTheMovieDBWithRequestFunction :: RequestFunction -> TheMovieDB a -> IO (Either Error a)
runTheMovieDBWithRequestFunction RequestFunction
f TheMovieDB a
t = ExceptT Error IO a -> IO (Either Error a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO a -> IO (Either Error a))
-> ExceptT Error IO a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ ReaderT RequestFunction (ExceptT Error IO) a
-> RequestFunction -> ExceptT Error IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (TheMovieDB a -> ReaderT RequestFunction (ExceptT Error IO) a
forall a.
TheMovieDB a -> ReaderT RequestFunction (ExceptT Error IO) a
unTMDB TheMovieDB a
t) RequestFunction
f