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 (..), Trait (..), TraitAbsence (..), probe)
newtype Method = Method HTTP.StdMethod
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
method ::
(Get h Method Request, ArrowChoice h, ArrowError RouteMismatch h) =>
HTTP.StdMethod ->
Middleware h req (Method : req)
method :: forall (h :: * -> * -> *) (req :: [*]).
(Get h Method Request, ArrowChoice h,
ArrowError RouteMismatch h) =>
StdMethod -> Middleware h req (Method : req)
method StdMethod
m RequestHandler h (Method : req)
nextHandler = forall t (ts :: [*]) (h :: * -> * -> *) a.
Get h t a =>
t -> h (Linked ts a) (Either (Absence t a) (Linked (t : ts) a))
probe (StdMethod -> Method
Method StdMethod
m) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (h :: * -> * -> *) a b. ArrowError RouteMismatch h => h a b
routeMismatch forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| RequestHandler h (Method : req)
nextHandler