{-# LANGUAGE CPP #-}
-- | Automatically produce responses to HEAD requests based on the underlying
-- applications GET response.
module Network.Wai.Middleware.Autohead (autohead) where

import Network.Wai
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mempty)
#endif

autohead :: Middleware
autohead :: Middleware
autohead Application
app Request
req Response -> IO ResponseReceived
sendResponse
    | Request -> Method
requestMethod Request
req Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
"HEAD" = Application
app Request
req { requestMethod :: Method
requestMethod = Method
"GET" } ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
        let (Status
s, ResponseHeaders
hs, (StreamingBody -> IO Any) -> IO Any
_) = Response
-> (Status, ResponseHeaders, (StreamingBody -> IO Any) -> IO Any)
forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream Response
res
        Response -> IO ResponseReceived
sendResponse (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> Builder -> Response
responseBuilder Status
s ResponseHeaders
hs Builder
forall a. Monoid a => a
mempty
    | Bool
otherwise = Application
app Request
req Response -> IO ResponseReceived
sendResponse