{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Symantic.HTTP.Client
 ( module Symantic.HTTP.Client
 , module Symantic.HTTP.Client.Connection
 ) where

import Data.Default.Class (Default(..))
import Data.Function (($), (.), id)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import GHC.Exts (IsList(..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as BS64
import qualified Data.List as List
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Sequence as Seq
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Types as HTTP
import qualified Web.HttpApiData as Web

import Symantic.HTTP.API
import Symantic.HTTP.MIME
import Symantic.HTTP.Client.Connection

-- * Type 'Client'
-- | @'Client' a k@ is a recipe to produce a 'ClientRequest'
-- from arguments 'a' (one per number of alternative routes).
--
-- 'Client' is analogous to a printf using a format customized for HTTP routing.
newtype Client a k
 =      Client
 {    unClient :: (ClientModifier -> k) -> a -- Right Kan extension
 }

-- | @'client' api@ returns the 'ClientRequest'
-- builders from the given 'api'.
client :: Client api ClientRequest -> api
client (Client cmd) = cmd ($ def)

-- ** Type 'ClientModifier'
type ClientModifier = ClientRequest -> ClientRequest

instance Cat Client where
	Client x <.> Client y = Client $ \k ->
		x $ \fx -> y $ \fy -> k $ fy . fx
instance Alt Client where
	Client x <!> Client y = Client $ \k ->
		x k :!: y k
	{-
	type AltMerge Client = (:!:)
	Client x <!> Client y = Client $ \k ->
		x (\cm -> let n:!:_ = k cm in n) :!:
		y (\cm -> let _:!:n = k cm in n)
	-}
	-- try = id -- FIXME: see what to do
instance Pro Client where
	dimap _a2b b2a r = Client $ \k -> unClient r k . b2a

instance HTTP_Path Client where
	type PathConstraint Client a = Web.ToHttpApiData a
	segment s = Client $ \k -> k $ \req ->
		req{ clientReqPath = clientReqPath req <> "/" <> Web.toEncodedUrlPiece s }
	capture' _n = Client $ \k a -> k $ \req ->
		req{ clientReqPath = clientReqPath req <> "/" <> Web.toEncodedUrlPiece a }
	captureAll = Client $ \k ss -> k $ \req ->
		req{ clientReqPath =
			List.foldl' (\acc s -> acc <> "/" <> Web.toEncodedUrlPiece s) "" $
			Web.toUrlPiece <$> ss
		 }
instance HTTP_Header Client where
	header n = Client $ \k v -> k $ \req ->
		req{ clientReqHeaders = clientReqHeaders req Seq.|> (n, Web.toHeader v) }
instance HTTP_BasicAuth Client where
	type BasicAuthArgs Client a k = BasicAuthUser -> BasicAuthPass -> k
	basicAuth' realm = Client $ \k user pass -> k $ \req ->
		req{ clientReqHeaders =
			let user_pass = Text.encodeUtf8 $ user<>":"<>pass in
			clientReqHeaders req Seq.|>
			 ( HTTP.hAuthorization
			 , Web.toHeader $ "Basic " <> BS64.encode user_pass
			 )
		 }
instance HTTP_Query Client where
	type QueryConstraint Client a = Web.ToHttpApiData a
	queryParams' n = Client $ \k vs -> k $ \req ->
		req{ clientReqQueryString =
			clientReqQueryString req <>
			fromList ((\v -> (n, Just $ Text.encodeUtf8 $ Web.toQueryParam v)) <$> vs) }
instance HTTP_Version Client where
	version v = Client $ \k -> k $ \req ->
		req{clientReqHttpVersion = v}
newtype ClientBodyArg a (ts::[*]) = ClientBodyArg a
instance HTTP_Body Client where
	type BodyArg Client = ClientBodyArg
	type BodyConstraint Client a ts = MimeTypes ts (MimeEncodable a)
	body' ::
	 forall a ts k repr.
	 BodyConstraint repr a ts =>
	 repr ~ Client =>
	 repr (BodyArg repr a ts -> k) k
	body'= Client $ \k (ClientBodyArg a) -> k $ \req ->
		req{clientReqBody =
			case NonEmpty.head (mimeTypes @ts) :: MimeType (MimeEncodable a) of
			 MimeType (mt::Proxy t) ->
				Just
				 ( Client.RequestBodyLBS $ mimeEncode mt a
				 , mediaType @t )
		 }
instance HTTP_Response Client where
	type ResponseConstraint Client a ts = MimeTypes ts (MimeDecodable a)
	type ResponseArgs       Client a ts = Proxy ts -> Proxy a -> ClientRequest
	type Response           Client      = ClientRequest
	response ::
	 forall a ts repr.
	 ResponseConstraint repr a ts =>
	 repr ~ Client =>
	 HTTP.Method ->
	 repr (ResponseArgs repr a ts)
	      (Response repr)
	response m = Client $ \k Proxy Proxy -> k $ \req ->
		req
		 { clientReqMethod = m
		 , clientReqAccept =
			clientReqAccept req <>
			fromList (toList $ mediaTypes @ts @(MimeDecodable a))
		 }

instance Web.ToHttpApiData BS.ByteString where
	toUrlPiece = Web.toUrlPiece . Text.decodeUtf8
	toHeader = id