<div dir="ltr"><div><div>Hi Michael,<br><br></div>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...<br>
<br>I'm also a bit worried about those (toHtml.show)s near the bottom.<br> <br><span style="font-family:comic sans ms,sans-serif">{-# LANGUAGE OverloadedStrings #-}<br><br>module Main where <br><br>import Network.Wai <br>
import Network.HTTP.Types <br>import Network.HTTP.Types.Header (hContentType, hContentLength, hConnection) <br>import Network.Wai.Handler.Warp (run) <br>import Blaze.ByteString.Builder (fromByteString, fromLazyByteString) <br>
import qualified Data.ByteString.Char8 as BS <br>import Data.Text<br><br>import qualified Text.Blaze.Html5 as H (form)<br>--import qualified Text.Blaze.Html5.Attributes as A<br>import Text.Blaze.Html5 <br>import Text.Blaze.Html5.Attributes <br>
import Text.Blaze.Html.Renderer.Utf8<br><br>import qualified Data.ByteString.Lazy as LB<br>import System.Environment (getEnv)<br>import Network.Wai.Parse (parseRequestBody, lbsBackEnd)<br><br>application:: Application <br>
application req =<br> parseRequestBody lbsBackEnd req >>= \(b,_) -><br> let (code, html) = app ((requestMethod req),(pathInfo req),(queryString req),b) in<br> return $ ResponseBuilder <br> code <br>
[ (hContentType, "text/html"), <br> (hConnection, "keep-alive")] <br> $ renderHtmlBuilder html<br><br>app x = case x of<br> ("GET", url, [], _) -> (status200, aform url)<br>
("GET", url, qs, _) -> (status200, gform qs)<br> ("POST", url, _, hsm) -> (status200, pform hsm)<br><br>aform :: [Text] -> Html<br>aform url = docTypeHtml $ do<br> body $ do<br> h3 "GETting form"<br>
H.form ! name "fooform" ! method "get" ! action "/in" $ <br> ( mapM_ (\n -> (toHtml n) >> input ! name (toValue n) ! type_ "text" >> br ) url )<br> >> input ! type_ "submit" ! value "Submit"<br>
h3 "POSTting form"<br> H.form ! name "fooform" ! method "post" ! action "/in" $ <br> ( mapM_ (\n -> (toHtml n) >> input ! name (toValue n) ! type_ "text" >> br ) url )<br>
>> input ! type_ "submit" ! value "Submit"<br><br>gform :: [QueryItem] -> Html<br>gform qs = docTypeHtml $ <br> body $ do<br> h3 "GETted form"<br> mapM_ (\(n,mv) -> "The " >> ((toHtml.show) n) >> " is " >> maybe "" (toHtml.show) mv >> br) qs <br>
<br>pform :: [(BS.ByteString, BS.ByteString)] -> Html<br>pform hs = docTypeHtml $ <br> body $ do <br> h3 "POSTed form"<br> mapM_ (\(n,v) -> "The " >> ((toHtml.show) n) >> " is " >> (toHtml.show) v >> br) hs <br>
<br>main:: IO () <br>main = getEnv "PORT" >>= flip run application . read<br></span><br></div>Adrian.<br><br><br></div><div class="gmail_extra"><br><br><div class="gmail_quote">On 9 July 2013 21:16, Adrian May <span dir="ltr"><<a href="mailto:adrian.alexander.may@gmail.com" target="_blank">adrian.alexander.may@gmail.com</a>></span> wrote:<br>
<blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr">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.<span class="HOEnZb"><font color="#888888"><br>
<br>Adrian.<br><br></font></span></div><div class="HOEnZb"><div class="h5"><div class="gmail_extra"><br><br><div class="gmail_quote">
On 9 July 2013 18:03, Michael Snoyman <span dir="ltr"><<a href="mailto:michael@snoyman.com" target="_blank">michael@snoyman.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<div dir="ltr">I've put together a more efficient version on School of Haskell:<div><br></div><div><a href="https://www.fpcomplete.com/user/snoyberg/random-code-snippets/wai-blaze-html" target="_blank">https://www.fpcomplete.com/user/snoyberg/random-code-snippets/wai-blaze-html</a><br>
</div><div><br></div><div>The differences from yours are:</div><div><ul><li>Instead of turning your H.Html into a lazy ByteString and then into a Builder, this code goes directly to a Builder via renderHtmlBuilder.</li><li>
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.</li><li>Doesn't use BS.pack, since OverloadedStrings makes it unnecessary.</li>
</ul></div></div><div class="gmail_extra"><br><br><div class="gmail_quote"><div><div>On Tue, Jul 9, 2013 at 11:44 AM, Adrian May <span dir="ltr"><<a href="mailto:adrian.alexander.may@gmail.com" target="_blank">adrian.alexander.may@gmail.com</a>></span> wrote:<br>
</div></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div><div><div dir="ltr"><div><div><div>Hi All,<br><br></div>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?<br>
<br></div>TIA,<br></div>Adrian<br><br><span style="font-family:comic sans ms,sans-serif">{-# LANGUAGE OverloadedStrings #-}<br><br>module Main where <br><br>import Network.Wai (Application, Response (ResponseBuilder)) <br>
import Network.HTTP.Types (status200) <br>import Network.HTTP.Types.Header (hContentType, hContentLength, hConnection) <br>import Network.Wai.Handler.Warp (run) <br>import Blaze.ByteString.Builder (fromByteString, fromLazyByteString) <br>
import qualified Data.ByteString.Char8 as BS (pack, length) <br><br>import qualified Text.Blaze.Html5 as H<br>import qualified Text.Blaze.Html5.Attributes as A<br>import Text.Blaze.Html.Renderer.Utf8<br><br>import qualified Data.ByteString.Lazy as LB<br>
<br>application:: Application <br>application _ = return $ <br> ResponseBuilder status200 [(hContentType, BS.pack "text/html"), <br> (hContentLength, BS.pack bodyLen), <br> (hConnection, BS.pack "keep-alive")] <br>
$ fromLazyByteString body <br> where body = root<br> bodyLen = show. LB.length $ body <br><br>root = renderHtml rooth<br><br>rooth :: H.Html<br>rooth = H.docTypeHtml $ do<br> H.body $ do<br>
H.h1 "Hello"<br><br>main:: IO () <br>main = run 8080 application <br><br></span><br></div>
<br></div></div>_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org" target="_blank">Beginners@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/beginners" target="_blank">http://www.haskell.org/mailman/listinfo/beginners</a><br>
<br></blockquote></div><br></div>
<br>_______________________________________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org" target="_blank">Beginners@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/beginners" target="_blank">http://www.haskell.org/mailman/listinfo/beginners</a><br>
<br></blockquote></div><br></div>
</div></div></blockquote></div><br></div>