    module Network.Wai.Middleware.AcceptOverride (
        -- $howto
        acceptOverride,
    ) where

    import Control.Monad (join)
    import Network.Wai

    import Network.Wai.Header (replaceHeader)

    -- $howto
    -- This 'Middleware' provides a way for the request itself to
    -- tell the server to override the \"Accept\" header by looking
    -- for the \"_accept\" query parameter in the query string and
    -- inserting or replacing the \"Accept\" header with that string.
    --
    -- For example:
    --
    -- @
    -- ?_accept=SomeValue
    -- @
    --
    -- This will result in \"Accept: SomeValue\" being set in the
    -- request as a header, and all other previous \"Accept\" headers
    -- will be removed from the request.

    acceptOverride :: Middleware
    acceptOverride :: Middleware
    acceptOverride Application
    app Request
    req =
        Application
    app Request
    req'
      where
        req' :: Request
    req' =
            case Maybe (Maybe ByteString) -> Maybe ByteString
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Maybe (Maybe ByteString) -> Maybe ByteString)
    -> Maybe (Maybe ByteString) -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString
    -> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ByteString
    "_accept" ([(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString))
    -> [(ByteString, Maybe ByteString)] -> Maybe (Maybe ByteString)
    forall a b. (a -> b) -> a -> b
    $ Request -> [(ByteString, Maybe ByteString)]
    queryString Request
    req of
                Maybe ByteString
    Nothing -> Request
    req
                Just ByteString
    a ->
                    Request
    req
                        { requestHeaders = replaceHeader "Accept" a $ requestHeaders req
                        }