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是HTTP 404.此时我完全不知道为什么。我还没有找到正确的函数调用。

有人知道如何解决这个问题吗？

Answer 1

我意识到为了访问表单数据，你需要进入 ServerPart monad

这不太对。要访问表单数据，您需要位于HasRqData实例的任何monad中。 ServerPart是提供该功能的基础monad，但像RouteT这样的monad变换器也有HasRqData个实例，可自动执行此操作。

因此，如果您为其提供与route

相同的返回类型，则原始generate_page_Output函数将起作用

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，因为您没有为expr提供look值来查找，因此它失败了。如果您希望expr是可选的，那么您应该这样做：

  expr <- optional $ look "expr"

这将使expr成为Maybe值。 optional来自Control.Applicative。

这是一个工作版本：

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

Happstack：Web路由和表单数据

1 个答案: