Yesod

时间:2016-01-08 10:55:50

标签: haskell yesod yesod-forms

我有一个程序,用户可以上传文件,对此文件进行一些验证,如果验证失败,我想通过javascript警告消息向用户提供反馈,而不是通过嵌入的消息在HTML本身。

理想情况下,一旦用户确认了警报消息(单击警报按钮),程序就可以重定向到另一条路线。

不幸的是,重定向似乎是立即发生的,在用户单击警报按钮之前不会暂停,因此完全错过了警报。

这是一个简单的代码片段,说明了问题:要求用户选择一个文件。如果是文本文件,则显示其名称,否则将生成警报。

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import Yesod

import Control.Concurrent.STM (TVar, newTVarIO, readTVarIO, atomically, writeTVar)

import Data.Text (Text)

data App = App (TVar Text)

mkYesod "App" [parseRoutes|
/ HomeR GET POST
/alert AlertR GET
|]

instance Yesod App

instance RenderMessage App FormMessage where
  renderMessage _ _ = defaultFormMessage

getHomeR :: Handler Html
getHomeR = do
    (formWidget, formEncType) <- generateFormPost uploadForm

    App ttxt <- getYesod
    txt      <- liftIO $ readTVarIO ttxt
    liftIO $ print txt
    defaultLayout $ do
     [whamlet| 
        <h1>Text file name: #{txt}
        <p>
        <form method=post action=@{HomeR} enctype=#{formEncType}>
            ^{formWidget} #
            <input type="submit" value="Upload File Name">
     |]

postHomeR :: Handler Html
postHomeR = do
    ((result, _), _) <- runFormPost uploadForm
    case result of
      FormSuccess fi -> do
        app <- getYesod
        case fileContentType fi of
            "text/plain" -> updateFileName app $ fileName fi
            _            -> redirect AlertR
      _ -> return ()   
    redirect HomeR

updateFileName :: App -> Text -> Handler ()
updateFileName app@(App ttxt) txtnew = 
    liftIO . atomically $ writeTVar ttxt txtnew

getAlertR :: Handler Html
getAlertR = do
    defaultLayout $ do
        setTitle "ALERT!"
        toWidgetBody [julius| 
                        alert("Only text files are accepted");
                     |]
    redirect HomeR 

uploadForm = renderDivs $ fileAFormReq "file"

main :: IO ()
main = do
    ttxt <- newTVarIO "nil"
    warp 3000 $ App ttxt

所以这不起作用,在getAlertR中,redirect HomeR代码在用户点击警报按钮之前不会“等待”(实际上甚至没有显示警报)。

为了解决这个问题,我改变了getAlertR:

getAlertR :: Handler Html
getAlertR = do
    defaultLayout $ do
        setTitle "ALERT!"
        toWidgetBody [julius| 
                        alert("Only text files are accepted");
                        location.assign("@{HomeR}"); 
                     |]
    -- redirect HomeR 

......哪作得好。

但这是我的问题:如果没有julius脚本中的路由,是否有更多“类似Yesod”的方法呢?

1 个答案:

答案 0 :(得分:1)

这基本上是“在Yesod范围之外”的问题:如果您希望基于响应警报框的用户进行行为,则必须在Javascript中处理,您的方法可以很好地运行。一旦进入Javascript世界,有几十种/几百种不同的方法(自动使用计时器?在页面上使用通知消息而不是单独的对话框等等),但是没有什么可以做服务器端来检查用户点击了一个没有Javascript支持的按钮。