Since IO can not be used inside Yesod Template, how can I display a simple current time on a page?
In my .hamlet file, something like:
<h2>
#{show $ getCurrentTime }
getCurrentTime :: IO UTCTime
In other words, you need to run the IO action outside of the template.
That outside means the template's handler. So I would write like this.
-- Home.hs
getHomeR = do
time <- liftIO getCurrentTime
defaultLayout $(widgetFile "homepage")
-- homepage.hamlet
<h2>#{show time}
Related
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?
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.
Apologies in advance for the code dump. I'm pretty new to both Yesod and Haskell and I'm struggling with CSRF issues. The problem as I understand it is that the form's _token isn't matching the environment token (running runFormPostNoToken works just fine). I have a pair of routes:
/ HomeR GET
/upload UploadR POST
The Handler for HomeR is defined as such:
getHomeR :: Handler Html
getHomeR = do
((res, uploadWidget), enctype) <- runFormPost imgForm
setTitle "Title"
$(widgetFile "homepage")
And the form itself and the upload Handler are:
imgForm :: Html -> MForm (HandlerT App IO) (FormResult Img, Widget)
imgForm hiddenInput = do
(titleRes, titleView) <- mreq textField uploadFormTitleSettings Nothing
(descRes, descView) <- mopt textareaField uploadFormDescriptionSettings Nothing
(fileRes, fileView) <- mreq fileField uploadFormAttachmentSettings Nothing
let imgRes = Img
<$> titleRes
<*> descRes
<*> fileRes
<*> pure (Likes 0)
<*> pure (Dislikes 0)
<*> pure (UserID 1)
<*> pure (Community 1)
let imgUploadWidget = do
toWidget
[whamlet|
^{ fvInput titleView }
^{ fvInput descView }
^{ fvInput fileView }
#{ hiddenInput }
<button type="submit">Submit
|]
return (imgRes, imgUploadWidget)
postImgUploadR :: HandlerT App IO Html
postImgUploadR = do
((imgRes, imgUploadWidget), enctype) <- runFormPost imgForm
let submission :: HandlerT App IO Html
submission = case imgRes of
FormSuccess upload -> defaultLayout [whamlet|The form was uploaded|]
FormMissing -> defaultLayout [whamlet|The form is missing|]
FormFailure upload -> defaultLayout [whamlet|The form failed.|]
submission
Unfortunately I'm not even sure what question to be asking here -- hopefully there's something obviously wrong with my code and someone can point me in the right direction. I spent some time reading through the source code of the functions and I think I understand it, but I'm not sure where the second, erroneous CSRF token is coming from (I assumed it would be set in a session variable and therefore wouldn't change). It's been quite a few hours and all my attempts to figure this out have failed.
Well, this turns out to be one of the most time-consuming bugs with one of the most mundane answers I've ever dealt with.
Some time ago I added in sslOnlySessions to makeSessionBackend and forgot about it. After trying to wrap my brain around every possible way I could have done something wrong, I took a step back, tried to think of a different angle to approach the problem from, and it hit me like a ton of bricks.
I'm posting this answer on the off chance someone 10 years from now will make the same dumb mistake I did, and after scouring their code for mistakes, finally fire up Google and find an easy answer.
Godspeed, future Haskeller.
I just initialized a Yesod project (no database) using yesod init.
My HomeR GET handler looks like this:
getHomeR :: Handler Html
getHomeR = do
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
handlerName = "getHomeR" :: Text
defaultLayout $ do
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
When using yesod devel, I can access the default homepage at http://localhost:3000/.
How can I modify the handler listed above to retrieve (and display) a HTTP GET query parameter like id=abc123 when accessing this URL:
http://localhost:3000/?id=abc123
Note: This question was answered Q&A-style and therefore intentionally doesn't show research effort!
I'll show two different methods to achieve this. For both, you'll need to add this code to your template, e.g. in homepage.hamlet:
Note that it is not guaranteed there is any id parameter present when accessing the URL, therefore the type resulting from both methods is Maybe Text. See the Shakespearean template docs for a detailed explanation of the template parameters.
Method 1: lookupGetParam
The easiest way you can do this is using lookupGetParam like this:
idValueMaybe <- lookupGetParam "id"
When using the default setting as generated by yesod init, idValueMaybe needs to be defined in both getHomeR and postHomeR if idValueMaybe is used in the template.
Your HomeR GET handler could look like this:
getHomeR :: Handler Html
getHomeR = do
idValueMaybe <- lookupGetParam "id"
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
handlerName = "getHomeR" :: Text
defaultLayout $ do
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
Method 2: reqGetParams
Instead of looking up the query parameters by name, you can also retrieve a list of query key/value pairs using reqGetParams. This can be advantageous in certain situations, e.g. if you don't know all possible keys in advance. Using the standard lookup function you can easily lookup a certain key in that list.
The relevant part of your code could look like this:
getParameters <- reqGetParams <$> getRequest
let idValueMaybe = lookup "id" getParameters :: Maybe Text
Your getHomeR could look like this:
getHomeR :: Handler Html
getHomeR = do
getParameters <- reqGetParams <$> getRequest
let idValueMaybe = lookup "id" getParameters :: Maybe Text
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
handlerName = "getHomeR" :: Text
defaultLayout $ do
aDomId <- newIdent
setTitle "Welcome To Yesod!"
$(widgetFile "homepage")
I want to share some data across requests in Yesod. In my case that data is a MVar (Data.Map Text ReadWriteLock), but I don't think the format of the data being shared matters too much here.
In Foundation.hs, there is a comment that says I can add fields to App, and every handler will have access to the data there. This seems like an approach I could use to share data between different handlers. I have been looking through the Yesod book, but I could not find any examples of getting data from App.
How would I access the newly created field from within a handler?
I think this might be a good use case for STM. I could share a TVar (Data.Map Text ReadWriteLock). But creating a TVar wraps the TVar in the STM monad. I might be mistaken, but to me that seems like the entire Yesod "main loop" would need to be run in the STM monad.
Is using STM a viable option here? Could anyone elaborate on how this might be achieved?
This tutorial for building a file server with Yesod shows quite nicely how you can use STM to access shared data. The relevant part starts from part 2.
To elaborate on pxqr's comment, you want to do something like this.
In your Foundation.hs file (assuming you started your project with yesod init).
data App = App
{ ... other fields
, shared :: TVar Int -- New shared TVar field
}
Then in your Application.hs file where you create the App instance.
makeFoundation conf = do
.... snip .....
tv <- newTVarIO 0 -- Initialize your TVar
let logger = Yesod.Core.Types.Logger loggerSet' getter
foundation = App conf s manager logger tv -- Add TVar here
return foundation
Then in your Handler use the TVar
getHomeR :: Handler Html
getHomeR = do
app <- getYesod -- Get the instance of App
x <- liftIO $ atomically $ do -- Read and update the TVar value.
val <- readTVar (shared app)
writeTVar (shared app) (val + 1)
return val
(formWidget, formEnctype) <- generateFormPost sampleForm
let submission = Nothing :: Maybe (FileInfo, Text)
handlerName = "getHomeR" :: Text
defaultLayout $ do
aDomId <- newIdent
-- Use the TVar value (increments on each page refresh).
setTitle $ fromString (show x)
$(widgetFile "homepage")
I have a scaffolded site and I am using this snippet of code in the Home Handler.
{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.Home where
import Import
import Yesod.Auth
getHomeR :: Handler RepHtml
getHomeR = do
defaultLayout $ do
maid <- maybeAuthId
setTitle "Welcome!"
$(widgetFile "homepage")
I would like to access maid in my homepage.hamlet file. However, I get the following error:
Handler/Home.hs:10:17:
Couldn't match expected type `WidgetT site0 IO t0'
with actual type `HandlerT master0 IO (Maybe (AuthId master0))'
In a stmt of a 'do' block: maid <- maybeAuthId
In the second argument of `($)', namely
`do { maid <- maybeAuthId;
setTitle "Welcome!";
$(widgetFile "homepage") }'
In a stmt of a 'do' block:
defaultLayout
$ do { maid <- maybeAuthId;
setTitle "Welcome!";
$(widgetFile "homepage") }
I get the above error message whether or not I put any contents inside homepage.hamlet. Instead of using $(widgetFile "homepage"), if I paste the whamlet code snippet from the Yesod Book (Auth section), it works fine.
If I remove the call to maybeAuthId, the issue goes away too. I am guessing it is something to do with the call to maybeAuthId and using the widgetFile but I am not sure how to fix the issue. Any help appreciated.
Thanks!
maybeAuthId lives in the Handler monad, and the inside of defaultLayout is a Widget, which is why you have a mismatch. You could do one of the following:
Convert the Handler action to a Widget action using handlerToWidget
Move the maybeAuthId call to before defaultLayout