Happstack: web routes and form data

Question

OK, so yesterday I tried to actually use Happstack for real.

OK, so my actual question. I've got this so far:

data LambdaURL =
  URL_CSS   |
  URL_Input |
  URL_Output

instance PathInfo LambdaURL where
  toPathSegments url =
    case url of
      URL_CSS    -> ["Main.css"]
      URL_Input  -> ["Input.html"]
      URL_Output -> ["Output.html"]

  fromPathSegments =
    (segment "Main.css"    >> return URL_CSS   ) <|>
    (segment "Input.html"  >> return URL_Input ) <|>
    (segment "Output.html" >> return URL_Output)

route :: LambdaURL -> RouteT LambdaURL (ServerPartT IO) Response
route url =
  case url of
    URL_CSS    -> serveFile (asContentType "text/css") "Main.css"
    URL_Input  -> ok $ toResponse $ page_Input
    URL_Output -> ok $ toResponse $ page_Output

main = simpleHTTP nullConf $ implSite "www.example.com" "" (setDefault URL_Input $ mkSitePI (runRouteT route))

page_Input :: H.Html

page_Output :: H.Html

So that's the tutorial on web-routes. Now I go read the tutorial on forms, and I realise that in order to access form data, you need to be in the ServerPart monad, not the Html monad. So I end up doing something like

generate_page_Output :: ServerPart Response
generate_page_Output = do
  decodeBody (defaultBodyPolicy "." 0 65536 65536)
  expr <- look "expr"
  ok $ toResponse $ page_Output expr

page_Output :: String -> H.Html

Now I go modify the route function to call generate_page_Output rather than page_Output. Presumably like this:

URL_Output -> generate_page_Output

Well, what do you know? That doesn't type-check. route lives in the RouteT monad, while I'm trying to do stuff in the ServerPart monad. Eventually I find liftRouteT :: m a -> RouteT url m a. Seems likely, eh? So if I change the line to

URL_Output -> liftRouteT generate_page_Output

now it compiles. The fun thing is... now the output page URL is HTTP 404. At this point I have absolutely no idea why. I just haven't found the correct function call yet.

Does anybody have a clue how to fix this?

Answer 1

I realise that in order to access form data, you need to be in the ServerPart monad

That is not quite right. In order to access the form data you need to be in any monad which is an instance of HasRqData. ServerPart is the base monad that provides that functionality, but the monad transformers like RouteT also have HasRqData instances which do the lifting automatically.

So, your original generate_page_Output function works if you give it the same return type as route

generate_page_Output :: RouteT LambdaURL (ServerPartT IO) Response
generate_page_Output = do
  decodeBody (defaultBodyPolicy "." 0 65536 65536)
  expr <- look "expr"
  ok $ toResponse $ page_Output expr

No lifeRouteT required.

The output page is probably 404 because you did not supply an expr value for look to find, so it fails. If you want the expr to be optional then you should do:

  expr <- optional $ look "expr"

which will make expr a Maybe value. optional comes from Control.Applicative.

Here is a working version:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Data.Monoid
import Happstack.Server
import Happstack.Server
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Web.Routes
import Web.Routes.Happstack


data LambdaURL =
  URL_CSS   |
  URL_Input |
  URL_Output

instance PathInfo LambdaURL where
  toPathSegments url =
    case url of
      URL_CSS    -> ["Main.css"]
      URL_Input  -> ["Input.html"]
      URL_Output -> ["Output.html"]

  fromPathSegments =
    (segment "Main.css"    >> return URL_CSS   ) <|>
    (segment "Input.html"  >> return URL_Input ) <|>
    (segment "Output.html" >> return URL_Output)

route :: LambdaURL -> RouteT LambdaURL (ServerPartT IO) Response
route url =
  case url of
    URL_CSS    -> serveFile (asContentType "text/css") "Main.css"
    URL_Input  -> ok $ toResponse $ page_Input
    URL_Output -> generate_page_Output

main = simpleHTTP nullConf $ implSite "www.example.com" "" (setDefault URL_Input $ mkSitePI (runRouteT route))

page_Input :: H.Html
page_Input =
    H.html $ do
      H.head $ do
        H.title "input"
      H.body $ do
       H.p $ H.a ! A.href "Output.html?expr=foo" $ "output"


page_Output :: String -> H.Html
page_Output expr =
    H.html $ do
      H.head $ do
        H.title "output"
      H.body $ do
        H.p $ do "expr is: "
                 H.toHtml expr

generate_page_Output :: RouteT LambdaURL (ServerPartT IO) Response
generate_page_Output = do
  decodeBody (defaultBodyPolicy "." 0 65536 65536)
  expr <- look "expr"
  ok $ toResponse $ page_Output expr