loginHandler = do
tp <- getRouteToParent
lift $ defaultLayout $ do
--setTitleI Msg.LoginTitle
master <- getYesod
--mapM_ ( flip apLogin tp ) ( authPlugins master )
[whamlet|<h3>Authentication providers|]
let ws = mapM ( flip apLogin tp ) ( authPlugins master )
[whamlet|
<ul>
$forall w <- ws
<li>^{w}
|]
In the code above (it doesn't compile) I'm trying to list all available authentication providers in a html list (ul, li, etc)...
Normally widgets are combined easily side-by-side: w1 >> w2 >> w3 ... Is there any way to inject (!) one widget inside another?
It's usually best to include error messages with a question like this. I believe the answer is to replace mapM with map, but it's hard to tell given that I don't know why the current code doesn't work.
Related
I'm trying to optimise an Yesod application so that it runs in constant space.
For example, I'm reading a DB table and display it as an HTML table. I should be able to start sending the first row before having finished processing the full table. I understand I can do that using selectSource(to read the DB) and responseSource or responseSourceDB but I how can wrap it in the default layout using defaultLayout ?
At the moment I have to consume the full source to generate a list and the Html in one go. For example let say I have (might not compiles)
data User = {name :: Text, email :: Text } deriving ...
userSource = selectSource [] [Asc UserName]
userToTR user = [whamlet|
<tr>
<td>#{user name}
<td>#{user email}
getUsers :: Handler Html
getUsers = do
rows <- runConduit $ userSource =$= mapC userToTR =$= sinkList
table = [whamlet|
<table>
<tr>
<th>Name
<th>Email
^{mconcat rows}
defaultLayout table
How I can transform this to stream the rows nicely ?
(This is only a made up example to explain the problem, the real problem is much more complicated).
I have a Yesod app, with a table in my database with a flag with three posible states (ToUse, Using, Used), bu default ToUse.
when a user click a button the flag in database change to Using, the idea is that after 10 minutes if the flag was not change to Used (operation that make another user with another button) the flag go back to ToUSe, the problem is that searching i can't find a method to delay the operation to edit my database and I'm not sure if it is possible in Yesod
Searching I find timeout library but if I understand right that library only stop the execution of a program don't delay his start
I try to use Control.Concurrent but, get the following error
testTimeOut = do
c1 <- atomically $ newTQueue
C.forkIO $ do
C.threadDelay (2 * 1000000)
id <- runDB $ insert $ SubForm "ToUse" 10
atomically $ do
writeTQueue c1 "result 1"
Couldn't match expected type ‘IO t0’
with actual type ‘HandlerT site0 IO (Key SubForm)’
EDIT
This code work form me
getFooR :: Handler RepHtml
getFooR = do
runInnerHandler <- handlerToIO
liftIO $ forkIO $ runInnerHandler $ do
Code here runs inside GHandler but on a new thread.
This is the inner GHandler.
...
Code here runs inside the request's control flow.
This is the outer GHandler.
...
I assume you are looking for forkHandler.
Problem description
I've been unable to get a compiling example of using Yesod.Auth.Hardcoded. My problem is in trying to interrogate the user in a hamlet template. My Foundation.hs is set up as per the documentation in the link for hardcoded. My handler looks like this:
getHomeR :: Handler Html
getHomeR = do
uid <- maybeAuthId
(widget, enctype) <- generateFormPost . renderBootstrap3 BootstrapBasicForm $ blurbForm Nothing
currentPost <- runDB $ selectFirst [] [Desc BlogId]
currentBlurb <- runDB $ selectFirst [] [Desc BlurbId]
defaultLayout $ do
setTitle "My site"
addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.11.2/jquery.min.js"
addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.2.0/js/collapse.js"
$(widgetFile "homepage")
My site compiles and renders happily until I try to do anything useful with the uid being assigned in the do block above.
What I've tried
I've tried both the $maybe and $case constructs in the hamlet documentation. $maybe looked like this:
$maybe user <- uid
<p>There's a name
$nothing
<p>No name
This succeeded regardless of whether I logged in as the hardcoded user.
The $case version looked like this:
$case uid
$of Left _
<p>There's no name
$of Right username
<p>It worked
and failed with:
Exception when trying to run compile-time code:
Inside a $case there may only be $of. Use '$of _' for a wildcard.
Code: widgetFile "homepage"
In the splice: $(widgetFile "homepage")
Question(s)
Am I setting the uid correctly in my handler code and, if so, how should I access the hardcoded SiteManager in my templates?
As often posting the question made me think of an answer, though I'd still be grateful for any better ones. Using a combination of $maybe and $case like so:
$maybe user <- uid
$case user
$of Left _
<p>There's no name
$of Right username
<p>There might be a name of #{username}
$nothing
<p>No name
got me the correct username. Please post another answer if there is a better way.
The AuthId type here is Either UserId String.
A Right value represents a "hardcoded" user which does not appear in the User table. A Left value represents a User row in the Users table.
If you want to show a name for an AuthId, you can call getAuthEntity which returns an Either User SiteManager and then process it like this:
getUserName :: Either User SiteManager -> String
getUserName (Left user) = ...get the name field from user...
getUserName (Right sitemgr) = manUserName sitemgr
I'd like to display a list of items in a webpage, along with associated details from a separate table (with a many-to-one relationship). How do I do this in Yesod? I am using the default scaffolding. The upshot is that runDB cannot be nested in a WidgetT context — or so I think.
To make this more concrete, how do I define the function featuresAssociatedWith to use in the following hamlet code:
<h2> Cars
$forall Entity carId car <- carList
<div class="car-item">
<h3> #{carYear car} #{carMake car} #{carModel car}
<ul>
$forall feature <- featuresAssociatedWith carId
<li> #{feature}
Given the following models:
Car
make Text
model Text
year Int
CarFeature
car CarId
text Text
UniqueCF car text
Here is the current handler function
getCarListR :: Handler Html
getCarListR = do
carList <- runDB $ selectList [] [Asc CarOrder]
liftIO $ print $ length carList
defaultLayout $ do
setTitle "Cars"
$(widgetFile "carList")
It seems most natural to embed a runDB query in the Widget this way, but again, this isn't possible:
featuresAssocWith :: CarId -> [Entity CarFeature]
featuresAssocWith carID = selectList [CarFeatureCar ==. carID] []
Hamlet is designed to not allow you to perform actions like database queries inside of it. Instead, you'll need to perform the query outside of hamlet, and then pass in a list of tuples of car info together with the data from the associated table.
I'm using Snap to create a fairly simple portfolio that, for the most part, just stores stuff in the database and shows it to the user. One of the features I'd like to have is the ability to show off retired designs for my portfolio. Each design would be little more than a single template and a handfull of assets (images, css, etc.). For organizational purposes, I would like to keep everything belonging to a single design together and separate from the templates/assets for my portfolio.
src/Site.hs
static/images/logo.png
static/css/responsive.css
archives/foo.com/2012-03/index.html
archives/foo.com/2012-03/images/logo.png
archives/foo.com/2012-03/css/styles.css
archives/foo.com/2012-03/favicion.ico
archives/bar.com/2011-08/index.html
archives/bar.com/2011-08/images/logo.png
archives/bar.com/2011-08/css/styles.css
archives/bar.com/2011-08/favicion.ico
I did try using serveDirectory on archives. Requesting example.com/bar.com/2012/03/ requests archives/bar.com/2012/03/index.html as one would expect and that's fine for some instances. I would like to be able to use some compiled splices or Charade so that the page doesn't look so empty when the original content can't be replicated (usually because it came from a database that's long forgotten).
Maybe making a separate snaplet for this purpose makes more sense? If so, how would I go about doing this? For reference, my site's snaplet is fairly basic and looks something like this:
app :: SnapletInit App App
app = makeSnaplet "connex" "A snaplet for the connex site." Nothing $ do
h <- nestSnaplet "heist" heist $ heistInit' "templates" defaultHeistState
s <- nestSnaplet "session" sess $ initCookieSessionManager "config/site_key.txt" "session" (Just 86400)
d <- nestSnaplet "db" db pgsInit
addRoutes
[ ("/", indexH siteH)
-- more routes here
, ("", serveDirectory "static")
]
return $ App h s d
where
defaultHeistState = mempty {
hcInterpretedSplices = defaultInterpretedSplices,
hcLoadTimeSplices = defaultLoadTimeSplices
}
(P.S. I have a similar but unrelated project that allows users to customize the appearance of their own "site". Currently, customization is limited to images and CSS. If the solution for the above problem could be used to allow customizing the layout template for each user, that would be great. If not, no worries.)
You'll probably have to do some manual wiring to get this to work the way you want, but there are some helpers that you can use. First there is the addTemplatesAt function that lets you include external templates in your HeistState. You can use that in combination with your own serveDirectory routes to serve the static resources. Once you get this working for one case, I'm sure you'll be able to find a way to combine the two in an abstraction that lets you pretty easily add multiple versions of your site's previous look.
Here's the detailed solution I ended up with for my primary use case:
app :: SnapletInit App App
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
h <- nestSnaplet "heist" heist $ heistInit' "templates" defaultHeistState
s <- nestSnaplet "sess" sess $ initCookieSessionManager "site_key.txt" "sess" (Just 3600)
d <- nestSnaplet "db" db pgsInit
addRoutes routes
addTemplatesAt h "archives" "archives" -- added this
return $ App h s d
where
defaultHeistState = mempty
{ hcInterpretedSplices = defaultInterpretedSplices
, hcLoadTimeSplices = defaultLoadTimeSplices
}
The handler to serve my templates looks like this (very similar to what heistServe looks like):
archiveServe :: AppHandler ()
archiveServe = do
url <- withRequest (return . rqPathInfo)
let
splices = return ()
template = "archives/" <> url <> "index"
renderWithSplices template splices
And my routes:
designH = route
[ ("/", ifTop designIndexH)
, ("/archives/", archiveServe)
, ("/archives/", serveDirectory "archives")
]