-- |
-- Copyright        : (c) Raghu Kaippully, 2020
-- License          : MPL-2.0
-- Maintainer       : rkaippully@gmail.com
--
-- Middlewares related to HTTP methods.
module WebGear.Middlewares.Method
  ( method
  ) where

import Control.Arrow (Kleisli (..))
import Control.Monad ((>=>))

import WebGear.Route (MonadRouter (..))
import WebGear.Trait (linkplus)
import WebGear.Trait.Method (IsStdMethod, Method)
import WebGear.Types (RequestMiddleware)


-- | A middleware to check whether the request has a specified HTTP
-- method.
--
-- Typically this would be used with a type application such as:
--
-- > method @GET handler
--
-- It is also idiomatic to use the template haskell quasiquoter
-- 'WebGear.Middlewares.Path.match' in cases where both HTTP method
-- and path needs to be matched.
method :: forall t m req res a. (IsStdMethod t, MonadRouter m)
       => RequestMiddleware m req (Method t:req) res a
method :: RequestMiddleware m req (Method t : req) res a
method handler :: Handler m (Method t : req) res a
handler = (Linked req Request -> m (Linked res (Response a)))
-> Kleisli m (Linked req Request) (Linked res (Response a))
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((Linked req Request -> m (Linked res (Response a)))
 -> Kleisli m (Linked req Request) (Linked res (Response a)))
-> (Linked req Request -> m (Linked res (Response a)))
-> Kleisli m (Linked req Request) (Linked res (Response a))
forall a b. (a -> b) -> a -> b
$ forall t a (m :: * -> *) (ts :: [*]).
Trait t a m =>
Linked ts a -> m (Either (Fail t a) (Linked (t : ts) a))
forall a (m :: * -> *) (ts :: [*]).
Trait (Method t) a m =>
Linked ts a
-> m (Either (Fail (Method t) a) (Linked (Method t : ts) a))
linkplus @(Method t) (Linked req Request
 -> m (Either MethodMismatch (Linked (Method t : req) Request)))
-> (Either MethodMismatch (Linked (Method t : req) Request)
    -> m (Linked res (Response a)))
-> Linked req Request
-> m (Linked res (Response a))
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (MethodMismatch -> m (Linked res (Response a)))
-> (Linked (Method t : req) Request -> m (Linked res (Response a)))
-> Either MethodMismatch (Linked (Method t : req) Request)
-> m (Linked res (Response a))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m (Linked res (Response a))
-> MethodMismatch -> m (Linked res (Response a))
forall a b. a -> b -> a
const m (Linked res (Response a))
forall (m :: * -> *) a. MonadRouter m => m a
rejectRoute) (Handler m (Method t : req) res a
-> Linked (Method t : req) Request -> m (Linked res (Response a))
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Handler m (Method t : req) res a
handler)