{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Symantic.HTTP.Command 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 Language.Symantic.HTTP.Media
import Language.Symantic.HTTP.API
import Language.Symantic.HTTP.Client
import Language.Symantic.HTTP.Mime

-- * Type 'Command'
-- | 'Command a k' is a recipe to produce a 'ClientRequest'
-- from arguments 'a' (one per number of alternative routes).
--
-- 'Command' is analogous to a printf using a format customized for HTTP routing.
newtype Command a k = Command { unCommand :: (CommandModifier -> k) -> a} -- Right Kan extension
 -- deriving (Functor {-, Applicative, Alternative, Monad, MonadPlus, P.MonadParsec RouteError RouteTokens-})

-- | Useful to constrain 'repr' to be 'Command'.
command :: Command a k -> Command a k
command = id

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

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

instance Appli Command where
	Command x <.> Command y = Command $ \k ->
		x $ \fx -> y $ \fy -> k $ fy . fx
instance Altern Command where
	Command x <!> Command y = Command $ \k ->
		x k :!: y k
	{-
	type AlternMerge Command = (:!:)
	Command x <!> Command y = Command $ \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 HTTP_Path Command where
	segment s  = Command $ \k -> k $ \req ->
		req{ clientReqPath = clientReqPath req <> "/" <> Web.toEncodedUrlPiece s }
	capture' _n = Command $ \k a -> k $ \req ->
		req{ clientReqPath = clientReqPath req <> "/" <> Web.toEncodedUrlPiece a }
	captureAll = Command $ \k ss -> k $ \req ->
		req{ clientReqPath =
			List.foldl' (\acc s -> acc <> "/" <> Web.toEncodedUrlPiece s) "" $
			Web.toUrlPiece <$> ss
		 }
instance HTTP_Method Command where
	method m = Command $ \k -> k $ \req ->
		req{ clientReqMethod = m }
instance HTTP_Header Command where
	header n = Command $ \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_Accept Command where
	accept mt = Command $ \k -> k $ \req ->
		req{ clientReqAccept = clientReqAccept req Seq.|> mediaType mt }
instance HTTP_Query Command where
	query n = Command $ \k vs -> k $ \req ->
		req{ clientReqQueryString = clientReqQueryString req <> fromList ((n,) <$> vs) }
	queryFlag n = Command $ \k b -> k $ \req ->
		if b
		then req{ clientReqQueryString = clientReqQueryString req Seq.|> (n, Nothing) }
		else req
instance HTTP_Version Command where
	version v = Command $ \k -> k $ \req ->
		req{clientReqHttpVersion = v}
instance HTTP_Endpoint Command where
	type Endpoint    Command = ClientRequest
	type EndpointArg Command = ClientRequestType
	endpoint' ::
	 forall repr k mt a.
	 MimeSerialize mt a =>
	 MimeUnserialize mt a =>
	 k ~ Endpoint repr =>
	 repr ~ Command =>
	 HTTP.Method ->
	 repr (EndpointArg repr mt a -> k) k
	endpoint' m = Command $ \k ClientRequestType -> k $ \req ->
		req
		 { clientReqMethod = m
		 , clientReqAccept = clientReqAccept req Seq.|> mediaType (Proxy::Proxy mt)
		 }