[Haskell-beginners] Getting warp and blaze to like each other

Michael Snoyman michael at snoyman.com
Tue Jul 9 12:03:09 CEST 2013


I've put together a more efficient version on School of Haskell:

https://www.fpcomplete.com/user/snoyberg/random-code-snippets/wai-blaze-html

The differences from yours are:

   - Instead of turning your H.Html into a lazy ByteString and then into a
   Builder, this code goes directly to a Builder via renderHtmlBuilder.
   - No content-length header is included in the output, since that would
   require rendering the builder to a lazy bytestring, which would be an
   unnecessary buffer copy.
   - Doesn't use BS.pack, since OverloadedStrings makes it unnecessary.



On Tue, Jul 9, 2013 at 11:44 AM, Adrian May
<adrian.alexander.may at gmail.com>wrote:

> Hi All,
>
> I just cobbled together the code below from a couple of samples, but got
> the types matched up by trial and error. I don't really understand when
> things are getting converted between lazy, strict, utf8, ascii, etc. I
> don't want ascii in the served page at all. Is it optimal?
>
> TIA,
> Adrian
>
> {-# LANGUAGE OverloadedStrings #-}
>
> module Main where
>
> import Network.Wai (Application, Response (ResponseBuilder))
> import Network.HTTP.Types (status200)
> import Network.HTTP.Types.Header (hContentType, hContentLength,
> hConnection)
> import Network.Wai.Handler.Warp (run)
> import Blaze.ByteString.Builder (fromByteString, fromLazyByteString)
> import qualified Data.ByteString.Char8 as BS (pack, length)
>
> import qualified Text.Blaze.Html5 as H
> import qualified Text.Blaze.Html5.Attributes as A
> import Text.Blaze.Html.Renderer.Utf8
>
> import qualified Data.ByteString.Lazy as LB
>
> application:: Application
> application _ = return $
>     ResponseBuilder status200 [(hContentType, BS.pack "text/html"),
>                                (hContentLength, BS.pack bodyLen),
>                                (hConnection, BS.pack "keep-alive")]
>                     $ fromLazyByteString body
>     where body = root
>           bodyLen = show. LB.length $ body
>
> root = renderHtml rooth
>
> rooth :: H.Html
> rooth = H.docTypeHtml $ do
>     H.body $ do
>         H.h1 "Hello"
>
> main:: IO ()
> main = run 8080 application
>
>
>
> _______________________________________________
> Beginners mailing list
> Beginners at haskell.org
> http://www.haskell.org/mailman/listinfo/beginners
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/beginners/attachments/20130709/44a1e8e7/attachment.htm>


More information about the Beginners mailing list