module Network.Wai.Middleware.MethodOverride
    ( methodOverride
    ) where

import Control.Monad (join)
import Network.Wai (Middleware, queryString, requestMethod)

-- | Overriding of HTTP request method via `_method` query string parameter.
--
-- This middleware only applies when the initial request method is POST.
-- Allows submitting of normal HTML forms, without worries of semantic
-- mismatches with the HTTP spec.
methodOverride :: Middleware
methodOverride :: Middleware
methodOverride Application
app Request
req =
    Application
app Request
req'
  where
    req' :: Request
req' =
        case (Request -> Method
requestMethod Request
req, Maybe (Maybe Method) -> Maybe Method
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Method) -> Maybe Method)
-> Maybe (Maybe Method) -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Method -> [(Method, Maybe Method)] -> Maybe (Maybe Method)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Method
"_method" ([(Method, Maybe Method)] -> Maybe (Maybe Method))
-> [(Method, Maybe Method)] -> Maybe (Maybe Method)
forall a b. (a -> b) -> a -> b
$ Request -> [(Method, Maybe Method)]
queryString Request
req) of
            (Method
"POST", Just Method
m) -> Request
req { requestMethod :: Method
requestMethod = Method
m }
            (Method, Maybe Method)
_ -> Request
req