1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Middleware.AcceptOverride
( acceptOverride
) where
import Network.Wai
import Control.Monad (join)
import Data.ByteString (ByteString)
acceptOverride :: Middleware
acceptOverride app req =
app req'
where
req' =
case join $ lookup "_accept" $ queryString req of
Nothing -> req
Just a -> req { requestHeaders = changeVal "Accept" a $ requestHeaders req}
changeVal :: Eq a
=> a
-> ByteString
-> [(a, ByteString)]
-> [(a, ByteString)]
changeVal key val old = (key, val)
: filter (\(k, _) -> k /= key) old
|
