Happstack: веб-маршруты и данные форм

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 монада, а не Html монада. В итоге я делаю что-то вроде

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 монада, пока я пытаюсь делать вещи в ServerPart монада. В конце концов я нахожу liftRouteT :: m a -> RouteT url m a, Кажется вероятным, а? Так что, если я изменю строку на

URL_Output -> liftRouteT generate_page_Output

теперь он компилируется. Самое интересное... теперь URL выходной страницы - HTTP 404. На данный момент я абсолютно не знаю, почему. Я просто еще не нашел правильный вызов функции.

Кто-нибудь знает, как это исправить?

Answer 1

Я понимаю, что для доступа к данным формы, вы должны быть в монаде ServerPart

Это не совсем верно. Чтобы получить доступ к данным формы, вы должны быть в любой монаде, которая является экземпляром 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 значение для 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