happstack-server 7.4.6 → 7.4.6.1
raw patch · 3 files changed
+33/−29 lines, 3 files
Files
- happstack-server.cabal +1/−1
- src/Happstack/Server/Internal/Types.hs +18/−15
- src/Happstack/Server/Response.hs +14/−13
happstack-server.cabal view
@@ -1,5 +1,5 @@ Name: happstack-server-Version: 7.4.6+Version: 7.4.6.1 Synopsis: Web related tools and services. Description: Happstack Server provides an HTTP server and a rich set of functions for routing requests, handling query parameters, generating responses, working with cookies, serving files, and more. For in-depth documentation see the Happstack Crash Course <http://happstack.com/docs/crashcourse/index.html> License: BSD3
src/Happstack/Server/Internal/Types.hs view
@@ -15,7 +15,8 @@ RsFlags(..), nullRsFlags, contentLength, chunked, noContentLength, HttpVersion(..), Length(..), Method(..), canHaveBody, Headers, continueHTTP, Host, ContentType(..),- readDec', fromReadS, readM, FromReqURI(..)+ readDec', fromReadS, readM, FromReqURI(..),+ showRsValidator ) where import Control.Monad.Error (Error(strMsg))@@ -44,7 +45,6 @@ import Happstack.Server.Internal.LogFormat (formatRequestCombined) import Numeric (readDec, readSigned) import System.Log.Logger (Priority(..), logM)-import Text.Show.Functions () -- | HTTP version data HttpVersion = HttpVersion Int Int@@ -223,21 +223,24 @@ instance Show Response where showsPrec _ res@Response{} =- showString "================== Response ================" .- showString "\nrsCode = " . shows (rsCode res) .- showString "\nrsHeaders = " . shows (rsHeaders res) .- showString "\nrsFlags = " . shows (rsFlags res) .- showString "\nrsBody = " . shows (rsBody res) .- showString "\nrsValidator = " . shows (rsValidator res)+ showString "================== Response ================" .+ showString "\nrsCode = " . shows (rsCode res) .+ showString "\nrsHeaders = " . shows (rsHeaders res) .+ showString "\nrsFlags = " . shows (rsFlags res) .+ showString "\nrsBody = " . shows (rsBody res) .+ showString "\nrsValidator = " . shows (showRsValidator (rsValidator res)) showsPrec _ res@SendFile{} =- showString "================== Response ================" .- showString "\nrsCode = " . shows (rsCode res) .- showString "\nrsHeaders = " . shows (rsHeaders res) .- showString "\nrsFlags = " . shows (rsFlags res) .- showString "\nrsValidator = " . shows (rsValidator res).- showString "\nsfFilePath = " . shows (sfFilePath res) .- showString "\nsfOffset = " . shows (sfOffset res) .+ showString "================== Response ================" .+ showString "\nrsCode = " . shows (rsCode res) .+ showString "\nrsHeaders = " . shows (rsHeaders res) .+ showString "\nrsFlags = " . shows (rsFlags res) .+ showString "\nrsValidator = " . shows (showRsValidator (rsValidator res)) .+ showString "\nsfFilePath = " . shows (sfFilePath res) .+ showString "\nsfOffset = " . shows (sfOffset res) . showString "\nsfCount = " . shows (sfCount res)++showRsValidator :: Maybe (Response -> IO Response) -> String+showRsValidator = maybe "Nothing" (const "Just <function>") -- what should the status code be ? instance Error Response where
src/Happstack/Server/Response.hs view
@@ -35,6 +35,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT import Happstack.Server.Internal.Monads (FilterMonad(composeFilter))+import Happstack.Server.Internal.Types import Happstack.Server.Types (Response(..), Request(..), nullRsFlags, getHeader, noContentLength, redirect, result, setHeader, setHeaderBS) import Happstack.Server.SURI (ToSURI) import qualified Text.Blaze.Html as Blaze@@ -315,18 +316,18 @@ -- | A nicely formatted rendering of a 'Response' prettyResponse :: Response -> String prettyResponse res@Response{} =- showString "================== Response ================" .- showString "\nrsCode = " . shows (rsCode res) .- showString "\nrsHeaders = " . shows (rsHeaders res) .- showString "\nrsFlags = " . shows (rsFlags res) .- showString "\nrsBody = " . shows (rsBody res) .- showString "\nrsValidator = " $ show (rsValidator res)+ showString "================== Response ================" .+ showString "\nrsCode = " . shows (rsCode res) .+ showString "\nrsHeaders = " . shows (rsHeaders res) .+ showString "\nrsFlags = " . shows (rsFlags res) .+ showString "\nrsBody = " . shows (rsBody res) .+ showString "\nrsValidator = " $ showRsValidator (rsValidator res) prettyResponse res@SendFile{} =- showString "================== Response ================" .- showString "\nrsCode = " . shows (rsCode res) .- showString "\nrsHeaders = " . shows (rsHeaders res) .- showString "\nrsFlags = " . shows (rsFlags res) .- showString "\nrsValidator = " . shows (rsValidator res).- showString "\nsfFilePath = " . shows (sfFilePath res) .- showString "\nsfOffset = " . shows (sfOffset res) .+ showString "================== Response ================" .+ showString "\nrsCode = " . shows (rsCode res) .+ showString "\nrsHeaders = " . shows (rsHeaders res) .+ showString "\nrsFlags = " . shows (rsFlags res) .+ showString "\nrsValidator = " . shows (showRsValidator (rsValidator res)) .+ showString "\nsfFilePath = " . shows (sfFilePath res) .+ showString "\nsfOffset = " . shows (sfOffset res) . showString "\nsfCount = " $ show (sfCount res)