Happstack:web路由和表单数据

Question

好吧，所以昨天我试着真正使用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 -> 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

这就是关于网络路由的教程。现在我阅读了关于表单的教程，我意识到为了访问表单数据，您需要在ServerPart monad中，而不是在Html monad中。所以我最终做了一些类似的事情

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

现在，我修改route函数以调用generate_page_Output而不是page_Output。大概是这样的：

URL_Output -> generate_page_Output

你知道什么？这不是类型检查。route住在RouteT monad中，而我正在尝试在ServerPart monad中做一些事情。最终我找到了liftRouteT :: m a -> RouteT url m a。看起来很可能，嗯？所以如果我把线路改成

URL_Output -> liftRouteT generate_page_Output

现在它正在编译。有趣的是…现在输出页面的URL是HTTP404。在这一点上，我完全不知道为什么。我只是还没有找到正确的函数调用。

有人知道怎么解决这个问题吗？

Answer 1

我意识到，为了访问表单数据，您需要服务器部件monad

这不太正确。为了访问表单数据，您需要在任何作为HasRqData实例的monad中。ServerPart是提供该功能的基本monad，但像RouteT这样的monad转换器也有自动提升的HasRqData实例。

因此，如果您为原始generate_page_Output函数提供与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

不需要lifeRouteT。

输出页面可能是404，因为您没有为look提供要查找的expr值，所以它失败了。如果你想让expr是可选的，那么你应该做：

  expr <- optional $ look "expr"

这将使CCD_ 19成为CCD_。CCD_ 21来源于CCD_。

这是一个工作版本：

{-# 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