-- | Stolen from rack: Sets the Content-Length header on responses with 
--   fixed-length bodies.

module Hack.Contrib.Middleware.ContentLength (content_length) where

import Hack
import Hack.Contrib.Constants
import Hack.Contrib.Response
import Hack.Contrib.Utils
import MPS.Light
import Prelude hiding ((.), (^), (>), (-))


content_length :: Middleware
content_length app = \env -> do
  response <- app env
  
  if should_size response
    then response
      .set_header _ContentLength (response.body.bytesize.show) .return
    else response .return
  
  where 
    should_size response =
      [  not - response.has_header _ContentLength
      ,  not - response.has_header _TransferEncoding
      ,  not - status_with_no_entity_body.has(response.status)
      ] .and