{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Language.Symantic.HTTP.API
 ( module Language.Symantic.HTTP.API
 , Functor(..), (<$>), ($>)
 , Applicative(..)
 , Alternative(..)
 ) where

import Control.Applicative (Applicative(..), Alternative(..))
import Data.Bool
import Data.Eq (Eq(..))
import Data.Functor (Functor(..), (<$>), ($>), (<$))
import Data.Maybe (Maybe(..))
import Data.Ord (Ord(..))
import Data.Proxy (Proxy(..))
import Data.String (String)
import Text.Show (Show(..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai

import Language.Symantic.HTTP.Media

-- * Class 'HTTP_API'
class
 ( Applicative    repr
 , Altern         repr
 , HTTP_Path      repr
 , HTTP_Method    repr
 , HTTP_Header    repr
 , HTTP_Accept    repr
 , HTTP_Query     repr
 , HTTP_Version   repr
 , HTTP_Endpoint  repr
 ) => HTTP_API repr

-- * Class 'Altern'
class Altern repr where
	-- | There Is No Alternative
	tina :: repr a
	(<+>) :: repr a -> repr a -> repr a; infixl 3 <+>
	try :: repr a -> repr a
	choice :: [repr a] -> repr a
	choice [] = tina
	choice (r:rs) = try r <+> choice rs
-- * Class 'HTTP_Path'
class HTTP_Path repr where
	segment    :: Segment -> repr ()
	capture    :: Name -> repr Segment
	captureAll :: repr [Segment]
type Segment     = T.Text
type Path        = [Segment]
type Name        = String
-- * Class 'HTTP_Method'
class HTTP_Method repr where
	method         :: HTTP.Method -> repr HTTP.Method
	method_GET     :: repr HTTP.Method
	method_POST    :: repr HTTP.Method
	method_HEAD    :: repr HTTP.Method
	method_PUT     :: repr HTTP.Method
	method_DELETE  :: repr HTTP.Method
	method_TRACE   :: repr HTTP.Method
	method_CONNECT :: repr HTTP.Method
	method_OPTIONS :: repr HTTP.Method
	method_PATCH   :: repr HTTP.Method
	method_GET     = method HTTP.methodGet
	method_HEAD    = method HTTP.methodHead
	method_PUT     = method HTTP.methodPut
	method_POST    = method HTTP.methodPost
	method_DELETE  = method HTTP.methodDelete
	method_TRACE   = method HTTP.methodTrace
	method_CONNECT = method HTTP.methodConnect
	method_OPTIONS = method HTTP.methodOptions
	method_PATCH   = method HTTP.methodPatch
-- * Class 'HTTP_Header'
class HTTP_Header repr where
	header :: HTTP.HeaderName -> repr HeaderValue
type HeaderValue = BS.ByteString
-- * Class 'HTTP_Accept'
class HTTP_Accept repr where
	accept :: ToMediaType mt a => Proxy mt -> repr (a -> BSL.ByteString)
	{-
	acceptCase :: Functor repr => Altern repr => [AcceptResponse repr a] -> repr BSL.ByteString
	acceptCase [] = tina $> BSL.empty
	acceptCase (AcceptResponse (mt,r) : rs) = try (accept mt r) <+> acceptCase rs
	-}
{-
data AcceptResponse repr a =
 forall mt. ToMediaType mt a =>
 AcceptResponse (Proxy mt, repr a)
-}
-- * Class 'HTTP_Query'
class HTTP_Query repr where
	query     :: QueryName -> repr [Maybe QueryValue]
	queryFlag :: QueryName -> repr Bool
type QueryName   = BS.ByteString
type QueryValue  = BS.ByteString
-- * Class 'HTTP_Version'
class HTTP_Version repr where
	version :: HTTP.HttpVersion -> repr HTTP.HttpVersion
-- * Class 'HTTP_Status'
class HTTP_Status repr where
	status :: StatusIs -> repr HTTP.Status
-- ** Type 'StatusIs'
data StatusIs
 =   StatusIsInformational
 |   StatusIsSuccessful
 |   StatusIsRedirection
 |   StatusIsClientError
 |   StatusIsServerError
 |   StatusIs HTTP.Status
 deriving (Eq, Ord, Show)
statusIs :: StatusIs -> (HTTP.Status -> Bool)
statusIs = \case
 StatusIsInformational -> HTTP.statusIsInformational
 StatusIsSuccessful    -> HTTP.statusIsSuccessful
 StatusIsRedirection   -> HTTP.statusIsRedirection
 StatusIsClientError   -> HTTP.statusIsClientError
 StatusIsServerError   -> HTTP.statusIsServerError
 StatusIs x            -> \y -> HTTP.statusCode x == HTTP.statusCode y
-- * Class 'HTTP_Response'
class HTTP_Response repr where
	response ::
	 ToMediaType mt a =>
	 HTTP.Method ->
	 Proxy mt ->
	 repr (HTTP.Status -> HTTP.ResponseHeaders -> a -> Wai.Response)

-- * Class 'HTTP_Endpoint'
class HTTP_Endpoint repr where
	type Endpoint repr :: * -> *
	endpoint ::
	 ToMediaType mt a =>
	 HTTP.Method ->
	 Proxy mt ->
	 repr (Endpoint repr a)