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 -> ByteString
requestMethod Request
req, forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ByteString
"_method" forall a b. (a -> b) -> a -> b
$ Request -> Query
queryString Request
req) of
            (ByteString
"POST", Just ByteString
m) -> Request
req { requestMethod :: ByteString
requestMethod = ByteString
m }
            (ByteString, Maybe ByteString)
_ -> Request
req