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

[Adrian May]

Hi Michael,

Seeing as you thought my puzzle would be useful to the community, I thought
that by the same logic you might want to update that sample you posted with
the next thing I had to bust my brain over. parseRequestBody gave me a bit
of a headache cos the only sample I could find was out of date and used
something called lbsSink. I'm sure you'd want to tidy it up first...

I'm also a bit worried about those (toHtml.show)s near the bottom.

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.Wai
import Network.HTTP.Types
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
import Data.Text

import qualified Text.Blaze.Html5 as H (form)
--import qualified Text.Blaze.Html5.Attributes as A
import Text.Blaze.Html5
import Text.Blaze.Html5.Attributes
import Text.Blaze.Html.Renderer.Utf8

import qualified Data.ByteString.Lazy as LB
import System.Environment (getEnv)
import Network.Wai.Parse (parseRequestBody, lbsBackEnd)

application:: Application
application req =
    parseRequestBody lbsBackEnd req >>= \(b,_) ->
    let (code, html) = app ((requestMethod req),(pathInfo req),(queryString
req),b) in
    return $ ResponseBuilder
               code
               [ (hContentType, "text/html"),
                 (hConnection, "keep-alive")]
               $ renderHtmlBuilder html

app x = case x of
  ("GET", url, [], _) -> (status200, aform url)
  ("GET", url, qs, _) -> (status200, gform qs)
  ("POST", url, _, hsm) -> (status200, pform hsm)

aform :: [Text] -> Html
aform url = docTypeHtml $ do
    body $ do
      h3 "GETting form"
      H.form ! name "fooform" ! method "get" ! action "/in" $
        ( mapM_ (\n -> (toHtml n) >> input ! name (toValue n) ! type_
"text" >> br )  url )
        >> input ! type_ "submit" ! value "Submit"
      h3 "POSTting form"
      H.form ! name "fooform" ! method "post" ! action "/in" $
        ( mapM_ (\n -> (toHtml n) >> input ! name (toValue n) ! type_
"text" >> br )  url )
        >> input ! type_ "submit" ! value "Submit"

gform :: [QueryItem] -> Html
gform qs = docTypeHtml $
    body $ do
      h3 "GETted form"
      mapM_ (\(n,mv) -> "The " >> ((toHtml.show) n) >> " is " >> maybe ""
(toHtml.show) mv >> br) qs

pform :: [(BS.ByteString, BS.ByteString)] -> Html
pform hs = docTypeHtml $
    body $ do
      h3 "POSTed form"
      mapM_ (\(n,v) -> "The " >> ((toHtml.show) n) >> " is " >>
(toHtml.show) v >> br) hs

main:: IO ()
main = getEnv "PORT" >>= flip run application . read

Adrian.




On 9 July 2013 21:16, Adrian May <adrian.alexander.may at gmail.com> wrote:

> Thanks! That's fantastic. Now I try to master that <*> trick to get
> something out of a post and then see if HaskellDB wants to eat it.
>
> Adrian.
>
>
>
> On 9 July 2013 18:03, Michael Snoyman <michael at snoyman.com> wrote:
>
>> 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
>>>
>>>
>>
>> _______________________________________________
>> 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/20130710/a9aaeee7/attachment-0001.htm>