Javascript Alerts in Yesod - haskell

Question

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?

Answer 1

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.