-- | 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 (Get (..), Prerequisite, Trait (..), TraitAbsence (..), 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
  }

instance Trait Method Request where
  type Attribute Method Request = HTTP.StdMethod

instance TraitAbsence Method Request where
  type Absence Method Request = MethodMismatch

type instance Prerequisite Method ts Request = ()

{- | 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 Request, ArrowChoice h, ArrowError RouteMismatch h) =>
  HTTP.StdMethod ->
  Middleware h ts (Method : ts)
method :: forall (h :: * -> * -> *) (ts :: [*]).
(Get h Method Request, 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 Request) (With Request (Method : ts)))
forall t (ts :: [*]) (h :: * -> * -> *) a.
(Get h t a, Prerequisite t ts a) =>
t -> h (With a ts) (Either (Absence t a) (With a (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 #-}