{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
-- | Types for possible backends to run client-side `Request` queries
module Servant.Client.Core.RunClient (
    RunClient (..),
    runRequest,
    RunStreamingClient (..),
    ClientF (..),
    ) where

import           Prelude ()
import           Prelude.Compat

import           Network.HTTP.Types.Status
                 (Status)
import           Control.Monad.Free
                 (Free (..), liftF)

import           Servant.Client.Core.ClientError
import           Servant.Client.Core.Request
import           Servant.Client.Core.Response

class Monad m => RunClient m where
  -- | How to make a request, with an optional list of status codes to not throw exceptions
  -- for (default: [200..299]).
  runRequestAcceptStatus :: Maybe [Status] -> Request -> m Response
  throwClientError :: ClientError -> m a

-- | How to make a request.
runRequest :: RunClient m => Request -> m Response
runRequest :: Request -> m Response
runRequest = Maybe [Status] -> Request -> m Response
forall (m :: * -> *).
RunClient m =>
Maybe [Status] -> Request -> m Response
runRequestAcceptStatus Maybe [Status]
forall a. Maybe a
Nothing

class RunClient m =>  RunStreamingClient m where
    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a

-------------------------------------------------------------------------------
-- Free
-------------------------------------------------------------------------------

-- | 'ClientF' cannot stream.
--
-- Compare to 'RunClient'.
data ClientF a
    = RunRequest Request (Response -> a)
    | Throw ClientError
  deriving (a -> ClientF b -> ClientF a
(a -> b) -> ClientF a -> ClientF b
(forall a b. (a -> b) -> ClientF a -> ClientF b)
-> (forall a b. a -> ClientF b -> ClientF a) -> Functor ClientF
forall a b. a -> ClientF b -> ClientF a
forall a b. (a -> b) -> ClientF a -> ClientF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ClientF b -> ClientF a
$c<$ :: forall a b. a -> ClientF b -> ClientF a
fmap :: (a -> b) -> ClientF a -> ClientF b
$cfmap :: forall a b. (a -> b) -> ClientF a -> ClientF b
Functor)

-- TODO: honour the accept-status argument.
instance ClientF ~ f => RunClient (Free f) where
    runRequestAcceptStatus :: Maybe [Status] -> Request -> Free f Response
runRequestAcceptStatus Maybe [Status]
_ Request
req  = ClientF Response -> Free f Response
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (Request -> (Response -> Response) -> ClientF Response
forall a. Request -> (Response -> a) -> ClientF a
RunRequest Request
req Response -> Response
forall a. a -> a
id)
    throwClientError :: ClientError -> Free f a
throwClientError = ClientF a -> Free f a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
f a -> m a
liftF (ClientF a -> Free f a)
-> (ClientError -> ClientF a) -> ClientError -> Free f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> ClientF a
forall a. ClientError -> ClientF a
Throw