-- | Traits and middlewares to handle HTTP methods.
module WebGear.Core.Trait.Method (
  Method (..),
  MethodMismatch (..),
  method,
) where

import Control.Arrow (ArrowChoice (..), (>>>))
import Control.Arrow.Operations (ArrowError)
import qualified Network.HTTP.Types as HTTP
import WebGear.Core.Handler (Middleware, RouteMismatch, routeMismatch)
import WebGear.Core.Request (Request)
import WebGear.Core.Trait (Absence, Attribute, Get (..), Prerequisite, probe)

-- | A trait for capturing the HTTP method of a request
newtype Method = Method HTTP.StdMethod

-- | Failure to match method against an expected value
data MethodMismatch = MethodMismatch
  { MethodMismatch -> Method
expectedMethod :: HTTP.Method
  , MethodMismatch -> Method
actualMethod :: HTTP.Method
  }

type instance Attribute Method Request = HTTP.StdMethod
type instance Absence Method = MethodMismatch
type instance Prerequisite Method ts = ()

{- | Check whether the request has a specified HTTP method.

 Example usage:

 > method @GET handler

 If the request does not have the specified method, another handler
 will be tried.

 It is also idiomatic to use the template haskell quasiquoter
 'WebGear.Core.Trait.Path.match' or 'WebGear.Core.Trait.Path.route' in
 cases where both an HTTP method and a path need to be matched.
-}
method ::
  (Get h Method, ArrowChoice h, ArrowError RouteMismatch h) =>
  HTTP.StdMethod ->
  Middleware h ts (Method : ts)
method :: forall (h :: * -> * -> *) (ts :: [*]).
(Get h Method, ArrowChoice h, ArrowError RouteMismatch h) =>
StdMethod -> Middleware h ts (Method : ts)
method StdMethod
m RequestHandler h (Method : ts)
nextHandler = Method
-> h (With Request ts)
     (Either (Absence Method) (With Request (Method : ts)))
forall t (ts :: [*]) (h :: * -> * -> *).
(Get h t, Prerequisite t ts) =>
t
-> h (With Request ts) (Either (Absence t) (With Request (t : ts)))
probe (StdMethod -> Method
Method StdMethod
m) h (With Request ts)
  (Either MethodMismatch (With Request (Method : ts)))
-> h (Either MethodMismatch (With Request (Method : ts))) Response
-> h (With Request ts) Response
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> h MethodMismatch Response
forall (h :: * -> * -> *) a b. ArrowError RouteMismatch h => h a b
routeMismatch h MethodMismatch Response
-> RequestHandler h (Method : ts)
-> h (Either MethodMismatch (With Request (Method : ts))) Response
forall b d c. h b d -> h c d -> h (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| RequestHandler h (Method : ts)
nextHandler
{-# INLINE method #-}