{-# 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