{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeApplications #-}
{-# 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.Sequence as Seq
import qualified Data.Text.Encoding as Text
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's
-- builders from the given 'api'.
client :: Client api ClientRequest -> api
client (Client cmd) = cmd ($ def)

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

type instance HttpApiData Client = Web.ToHttpApiData
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
	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 Web.ToHttpApiData BS.ByteString where
	toUrlPiece = Web.toUrlPiece . Text.decodeUtf8
	toHeader = id
instance HTTP_Query Client where
	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}
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 a ts = ClientRequest
	response ::
	 forall a ts repr.
	 ResponseConstraint repr a ts =>
	 repr ~ Client =>
	 HTTP.Method ->
	 repr (ResponseArgs repr a ts)
	      (Response repr a ts)
	response m = Client $ \k Proxy Proxy -> k $ \req ->
		req
		 { clientReqMethod = m
		 , clientReqAccept =
			clientReqAccept req <>
			fromList (listMediaTypes @ts @(MimeDecodable a))
		 }