← Back to branch summary

~ubuntu-branches/ubuntu/utopic/haskell-wai-extra/utopic-proposed

« back to all changes in this revision

Viewing changes to Network/Wai/Middleware/Autohead.hs

  • Committer: Package Import Robot
  • Author(s): Clint Adams
  • Date: 2014-06-06 11:40:45 UTC
  • mfrom: (15.1.1 sid)
  • Revision ID: package-import@ubuntu.com-20140606114045-cc7h7xuui844a1l0
Tags: 3.0.0-1
New upstream version.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Network/Wai/Middleware/Autohead.hs
4
4
module Network.Wai.Middleware.Autohead (autohead) where
5
5
 
6
6
import Network.Wai
7
 
import Network.Wai.Internal
8
7
import Data.Monoid (mempty)
9
8
 
10
9
autohead :: Middleware
11
 
autohead app req
12
 
    | requestMethod req == "HEAD" = do
13
 
        res <- app req { requestMethod = "GET" }
14
 
        let go (ResponseFile s hs _ _) = ResponseBuilder s hs mempty
15
 
            go (ResponseBuilder s hs _) = ResponseBuilder s hs mempty
16
 
            go (ResponseSource s hs _) = ResponseBuilder s hs mempty
17
 
            go (ResponseRaw raw r) = ResponseRaw raw (go r)
18
 
        return (go res)
19
 
    | otherwise = app req
 
10
autohead app req sendResponse
 
11
    | requestMethod req == "HEAD" = app req { requestMethod = "GET" } $ \res -> do
 
12
        let (s, hs, _) = responseToStream res
 
13
        sendResponse $ responseBuilder s hs mempty
 
14
    | otherwise = app req sendResponse
20
15