1

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

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

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生活在RouteTmonad 中，而我正在尝试在ServerPartmonad 中做事。最终我发现liftRouteT :: m a -> RouteT url m a. 好像很有可能吧？因此，如果我将行更改为

URL_Output -> liftRouteT generate_page_Output

现在它编译了。有趣的是……现在输出页面的 URL 是 HTTP 404。此时我完全不知道为什么。我只是还没有找到正确的函数调用。

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

4

1 回答 1

1

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

这不太对。为了访问表单数据，您需要位于任何 .monad 的实例中HasRqData。ServerPart是提供该功能的基本单子，但单子转换器RouteT也有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，因为您没有expr为 find 提供值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
于 2013-07-14T19:32:52.867 回答