{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Symantic.HTTP.Client
 ( module Symantic.HTTP.Client
 , module Symantic.HTTP.Client.Monad
 ) 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.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.Monad

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

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 Web.ToHttpApiData HeaderValue 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) }
	queryFlag n = Client $ \k b -> k $ \req ->
		if b
		then req{ clientReqQueryString = clientReqQueryString req Seq.|> (n, Nothing) }
		else req
instance HTTP_Version Client where
	version v = Client $ \k -> k $ \req ->
		req{clientReqHttpVersion = v}
instance HTTP_Response Client where
	type Response    Client = ClientRequest
	type ResponseArg Client = ClientRequestType
	response ::
	 forall repr k a mt.
	 MimeSerialize a mt =>
	 MimeUnserialize a mt =>
	 k ~ Response repr =>
	 repr ~ Client =>
	 HTTP.Method ->
	 repr (ResponseArg repr mt a -> k) k
	response m = Client $ \k ClientRequestType -> k $ \req ->
		req
		 { clientReqMethod = m
		 , clientReqAccept = clientReqAccept req Seq.|> mimeType (Proxy::Proxy mt)
		 }