{-| An Interpreter with http-client as the foundation
-}
{-# LANGUAGE BangPatterns   #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies   #-}

module Network.HTTP.Client.Free.HttpClient (
    HttpClient
    , runHttp
    , runTHttp
) where

import           Control.Monad.IO.Class          (MonadIO, liftIO)
import           Control.Monad.Trans             (MonadTrans, lift)
import           Control.Monad.Trans.Free.Church (FT, iterT, iterTM, liftF)
import           Data.ByteString.Lazy            (ByteString)
import           Network.HTTP.Client             (Manager, Request, Response,
                                                  httpLbs)
import           Network.HTTP.Client.Free.Types  (HttpF (HttpF), RequestType,
                                                  ResponseType)
import           Network.HTTP.Client.Free.Util   (setMethod)
import           Network.HTTP.Types.Method       (renderStdMethod)

-------------------------------------------------------------------------------
-- | 'HttpClient' is an uninhabited type used to identify the http-client
-- based interpreter
data HttpClient

-------------------------------------------------------------------------------
-- | HttpClient expects 'Request's and returns 'Response ByteString's
type instance RequestType  HttpClient = Request
type instance ResponseType HttpClient = Response ByteString

-------------------------------------------------------------------------------
-- | Peel a layer of the 'HttpF' functor and run an http request with the data
-- provided.
iterTHttp :: ( Request ~ RequestType client
             , Response ByteString ~ ResponseType client
             , Monad m
             , MonadIO m
             )
          => Manager
          -> HttpF client (m a)
          -> m a
iterTHttp manager (HttpF m r next) =
    let !req = setMethod m r in liftIO (httpLbs req manager) >>= next

-------------------------------------------------------------------------------
-- | Peel a layer of the 'HttpF' functor and run an http request with the data.
-- the base monad for this action is 't m'.
iterTMHttp :: ( Request ~ RequestType client
              , Response ByteString ~ ResponseType client
              , Monad m
              , MonadTrans t
              , Monad (t m)
              , MonadIO m
              )
    => Manager
    -> HttpF client (t m a)
    -> t m a
iterTMHttp manager (HttpF m r next) =
    let !req = setMethod m r in (lift . liftIO $ httpLbs req manager) >>= next

-------------------------------------------------------------------------------
-- | The main http-client interpreter. The client is free to specify the base
-- effect monad so long as there is an instance of 'MonadIO' for it in scope.
runHttp :: ( Request ~ RequestType client
           , Response ByteString ~ ResponseType client
           , Monad m
           , MonadIO m
           )
         => Manager
         -> FT (HttpF client) m a
         -> m a
runHttp manager = iterT (iterTHttp manager)

-------------------------------------------------------------------------------
-- | The main http-client interpreter. The client is free to specify the base
-- effect monad ('m'), and in thise case this the result can be lifted into a
-- higher monad transformer stack ('t')
runTHttp :: ( Request ~ RequestType client
            , Response ByteString ~ ResponseType client
            , Monad m
            , MonadIO m
            , MonadTrans t
            , Monad (t m)
            )
        => Manager
        -> FT (HttpF client) m a
        -> t m a
runTHttp manager = iterTM (iterTMHttp manager)