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 :: ma -> RouteT url ma 。 似乎可能吧？ 因此，如果我將行更改為

URL_Output -> liftRouteT generate_page_Output

現在可以編譯了。 有趣的是...現在輸出頁面的URL是HTTP404。在這一點上，我完全不知道為什么。 我只是還沒有找到正確的函數調用。

有人知道如何解決這個問題嗎？

Answer 1

我意識到，要訪問表單數據，您需要位於ServerPart monad中

那不是很正確。 為了訪問表格數據，您需要位於HasRqData實例的任何monad中。 ServerPart是提供該功能的基本monad，但是monad轉換器（如RouteT也具有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，因為您沒有提供用於look的expr值，所以它失敗了。 如果希望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