haskellyesodyesod-forms

Javascript Alerts in Yesod


I have a program where the user can upload a file, some validation of this file takes place, and if the validation fails, I would like to provide feedback to the user via a javascript alert message, rather than via a message embedded in the html itself.

Ideally, once the user has acknowledged the alert message (clicking the alert button), the program can redirect to another route.

Unfortunately the redirection seems to happen right away, without pausing until the user clicks the alert button, so the alert is missed altogether.

Here is a simple snippet which illustrates the problem : the user is asked to pick a file. If it is a text file its name is displayed, otherwise an alert is produced.

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

So this does not work and, in getAlertR, the redirect HomeR code does not "wait" until the user clicks the alert button (in fact the alert is not even displayed).

To get around the issue I have changed getAlertR like that :

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

... which works ok.

But here is my question : is there a more "Yesod-like" way to do this without having the routing inside the julius script?


Solution

  • This is basically an "outside the scope of Yesod" issue: if you want the behavior to occur based on a user responding to an alert box, it has to be handled in Javascript, in which can your approach works quite well. Once within the Javascript world, there are dozens/hundreds of different ways of doing this (automatically using a timer? use a notification message on the page instead of a separate dialog? etc), but there's nothing you can do server side to check that the user has clicked a button without Javascript support.