salvia-0.1: src/Network/Salvia/Handler/Head.hs

module Network.Salvia.Handler.Head (hHead) where

import Control.Applicative
import Control.Monad.State (put)
import Data.Record.Label
import Network.Protocol.Http
import Network.Salvia.Httpd

{- |
The 'hHead' handler makes sure no response body is sent to the client when the
request is an HTTP 'HEAD' request. In the case of a 'HEAD' request the
specified sub handler will be executed under the assumption that the request
was a 'GET' request, otherwise this handler will act as the identify function.
-}

hHead :: Handler a -> Handler a
hHead handler = do
  m <- getM (method % request)
  case m of
    HEAD -> withM (method % request) (put GET) $
              handler <* emptyQueue
    _    -> handler