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")
]
Related
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've got a yesod route with two handlers - one for GET and one for PUT:
getHotspotR :: Key Hotspot -> Handler Value
getHotspotR i = do
hotspot <- runDB $ get404 i
returnJson hotspot
putHotspotR :: Handler ()
putHotspotR = do
hotspot <- requireJsonBody
hid <- runDB $ insert $ hotspot
sendResponseCreated $ HotspotR hid
But I'm not sure what to do for the routing. If I do this:
/hotspot/#HotspotId HotspotR GET PUT
It complains that the PUT handler has the wrong airity:
Couldn't match expected type `Key Hotspot -> HandlerT App IO res0'
with actual type `HandlerT App IO ()'
The function `putHotspotR' is applied to one argument,
but its type `Handler ()' has none
But if I declare another route:
/hotspot/#HotspotId HotspotR GET
/hotspot HotspotR PUT
It complains that I've got a duplicate route:
/hotspot/#HotspotId HotspotR GET
/hotspot HotspotR PUT
Foundation.hs:48:1:
Multiple declarations of `HotspotR'
Declared at: Foundation.hs:48:1
Foundation.hs:48:1
Logically, these resources are not the same, even though they manipulate entities. HotspotR manipulates a single Hotspot. HotspotsR manipulates the set of Hotspots (e.g. by inserting into that set).
Make sure the routes are named differently.
/hotspots/ HotspotsR PUT
/hotspots/#HotspotId HotspotR GET
And then modify your put resource correspondingly.
putHotspotsR :: Handler ()
putHotspotsR = do { ... }
This will enable you to do the following in the future too.
/hotspots/ HotspotsR GET PUT -- list all hotspots, insert a hotspot
/hotspots/#HotspotId HotspotR GET PATCH -- Get a hotspot, update a hotspot.
I have fairly deep urls with IDs and I want to see if I can convert them into something nicer looking. I tried looking into how Slugs are done for Yesod Blog (https://github.com/yesodweb/yesod/wiki/Slugs) but not sure if I know how to translate that to what I am looking for here.
Suppose let's say I want to display Top Fiction Books, I have a resource that looks like this:
/topbooks/bookcategory/#BookCategoryId
If I go to /topbooks/bookcategory/1 I may get Fiction books, If I got to /topbooks/bookcategory/2 I may get Non-fiction, etc.
All my handlers use the #BookCategoryId input parameter in the database queries to get the appropriate records.
Ideally I would like to create a url that looks like: /topbooks/fiction, /topbooks/non-fictionetc. If I create my route as /topbooks/#Text, I can pattern match the string and return a Key back. However, I will have to manually transform it in every handler using #BookCategoryId. Note that the IDs are used as Foreign keys so it makes a bit cumbersome to rely on getBy like how it is done in Slug example.
So I am wondering if there is a better way to do it: Is it possible to define a custom type similar to Slug but instead of just converting values to/from Text / String, actually output IDs? That way I can just use the parameter directly in my queries.
Update:
To clarify given Michael's comment:
I understand we cannot get the IDs without doing a database lookup. In fact for this example, I am ok hard coding the look-up mechanism. I was just trying to see if the PathPiece mechanism will somehow simplify the conversion process.
For example, if something like this worked then it will be fine but of course I will get a type error since I am trying to return a Key when the compiler is expecting BookCategories.
data BookCategories = FICTION | NONFICTION
instance PathPiece BookCategories where
toPathPiece (FICTION) = T.pack "fiction"
toPathPiece (NONFICTION) = T.pack "nonfiction"
fromPathPiece s =
let ups = map toUpper $ T.unpack s
in
case reads ups of
[(FICTION, "")] -> Just $ Key $ PersistInt64 1
[(NONFICTION, "")] -> Just $ Key $ PersistInt64
[] -> Nothing
otherwise -> Nothing
Of course I could just return Just FICTION and unwrap it in my handler. This is not conceptually very different from actually pattern matching on Text directly with a function with a signature Text -> BookCategoryId.
getBookCategoryR :: BookCategoryId -> Handler Html
getBookCategoryR bcId = do
-- Normal use case when IDs are used in the URL
books <- runDB $ selectList [ModelBookCategory ==. bcId] []
If I swtich to Text input
getBookCategoryR :: Text -> Handler Html
getBookCategoryR bc = do
bcId = convertToId (bc) -- This is the line I am trying to avoid everywhere
books <- runDB $ selectList [ModelBookCategory ==. bcId] []
The one line conversion code is what I am trying to avoid. PathPiece has been handling it nicely for id-based-urls and kept the code clean. If there was a way to get Ids returned through some Type magic then it will be great. With limited knowledge of Haskell, I have no idea if it is even feasible.
Hope my question is clearer now.
Thanks!
No, there's no such way to do that, and the reason is simple: without consulting the database, there's no way to know if foo exists as a slug at all and, if it does, which ID it relates to. You'll always have to perform some database action to convert a slug into an ID.
UPDATE I'm still not certain I understand what you're looking for, but the short answer regarding PathPiece is that it only works on pure conversions, nothing which has side effects. If you're looking to write a function like Text -> Handler BookCategoryId, you can certainly do so. And if you really wanted to, you could even abstract this with a typeclass, though I'm not sure if you'll gain anything.
This may be barking up the wrong tree, but here's a short idea that might inspire you a bit: you could creating different newtype wrappers for each textual slug field, and then create a typeclass to convert a textual slug field into the appropriate entity, e.g.:
newtype BookCatSlug = BookCatSlug Text
deriving PathPiece
BookCategory
slug BookCatSlug
title Text
...
UniqueBookCat slug
class Slug slug where
type SlugEntity slug
lookupSlug :: slug -> YesodDB App (Maybe (Entity (SlugEntity slug)))
instance Slug BookCatSlug where
type SlugEntity BookCatSlug = BookCategory
lookupSlug = getBy . UniqueBookCat
lookupSlug404 slug = runDB (lookupSlug slug) >>= maybe notFound return
myHandler slug = do
Entity bookCatId bookCat <- lookupSlug404 slug
Something along these lines should work, but I'm not sure if the "type magic" is worthwhile, since having a helper function and manually passing in the appropriate Unique constructor would be almost as easy for the call site and result in much simpler error messages.
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.