{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}

module Dormouse.Client.Methods
  ( HttpMethod(..)
  , AllowedBody
  , methodAsByteString
  ) where

import qualified Data.ByteString as SB
import qualified Data.ByteString.Char8 as C8SB
import Data.Kind (Constraint)
import Data.Proxy ( Proxy )
import Dormouse.Client.Data ( Empty )
import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )

data HttpMethod (a :: Symbol) where 
  CONNECT :: HttpMethod "CONNECT"
  DELETE :: HttpMethod "DELETE"
  HEAD :: HttpMethod "HEAD"
  GET :: HttpMethod "GET"
  OPTIONS :: HttpMethod "OPTIONS"
  PATCH :: HttpMethod "PATCH"
  POST :: HttpMethod "POST"
  PUT :: HttpMethod "PUT"
  TRACE :: HttpMethod "TRACE"
  CUSTOM :: KnownSymbol a => Proxy a -> HttpMethod a

instance Show (HttpMethod a) where
  show :: HttpMethod a -> String
show HttpMethod a
CONNECT    = String
"CONNECT"
  show HttpMethod a
DELETE     = String
"DELETE"
  show HttpMethod a
HEAD       = String
"HEAD"
  show HttpMethod a
GET        = String
"GET"
  show HttpMethod a
OPTIONS    = String
"OPTIONS"
  show HttpMethod a
PATCH      = String
"PATCH"
  show HttpMethod a
POST       = String
"POST"
  show HttpMethod a
PUT        = String
"PUT"
  show HttpMethod a
TRACE      = String
"TRACE"
  show (CUSTOM Proxy a
p)   = ShowS
forall a. Show a => a -> String
show ShowS -> (Proxy a -> String) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy a -> String) -> Proxy a -> String
forall a b. (a -> b) -> a -> b
$ Proxy a
p

instance Eq (HttpMethod a) where
  == :: HttpMethod a -> HttpMethod a -> Bool
(==) HttpMethod a
_ HttpMethod a
_ = Bool
True

type family AllowedBody (a :: Symbol) b :: Constraint
type instance AllowedBody "CONNECT" b = (b ~ Empty)
type instance AllowedBody "DELETE" b = ()
type instance AllowedBody "GET" b = (b ~ Empty)
type instance AllowedBody "HEAD" b = (b ~ Empty)
type instance AllowedBody "OPTIONS" b = (b ~ Empty)
type instance AllowedBody "PATCH" b = ()
type instance AllowedBody "POST" b = ()
type instance AllowedBody "PUT" b = ()
type instance AllowedBody "TRACE" b = (b ~ Empty)

methodAsByteString :: HttpMethod a -> SB.ByteString
methodAsByteString :: HttpMethod a -> ByteString
methodAsByteString HttpMethod a
CONNECT    = ByteString
"CONNECT"
methodAsByteString HttpMethod a
DELETE     = ByteString
"DELETE"
methodAsByteString HttpMethod a
HEAD       = ByteString
"HEAD"
methodAsByteString HttpMethod a
GET        = ByteString
"GET"
methodAsByteString HttpMethod a
OPTIONS    = ByteString
"OPTIONS"
methodAsByteString HttpMethod a
PATCH      = ByteString
"PATCH"
methodAsByteString HttpMethod a
POST       = ByteString
"POST"
methodAsByteString HttpMethod a
PUT        = ByteString
"PUT"
methodAsByteString HttpMethod a
TRACE      = ByteString
"TRACE"
methodAsByteString (CUSTOM Proxy a
p) = String -> ByteString
C8SB.pack (String -> ByteString)
-> (Proxy a -> String) -> Proxy a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy a -> ByteString) -> Proxy a -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy a
p