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")
Related
I have been using this guide in order to add authentication and authorisation to my project. I am new to Yesod and have been running into some problems:
I am using the following foundation data:
data App = App (TChan Text)
For my authentication i need this data type:
data App = App SqlBackend
How can i combine the two? Do i then also have to change existing functions?
In the end i run everything like this:
main :: IO ()
main = runNoLoggingT $ withSqliteConn "email.db3" $ \conn -> liftIO $ do
runSqlConn (runMigration migrateAll) conn
chan <- newTChanIO
warp 3000 $ App chan
-- Backend SqlBackend needs to be initilized with conn (see below)
{- OLD
main = do
chan <- newTChanIO
warp 3000 $ App chan
-}
{- NEW
main = runNoLoggingT $ withSqliteConn "email.db3" $ \conn -> liftIO $ do
runSqlConn (runMigration migrateAll) conn
warp 3000 $ App conn
-}
I know that i have to combine the two. I read this article. How do i get chan and also conn together? It might sound trivial, but there is little documentation out there.
Please help me!
Typically people make their App datatype a record with multiple fields. For example, the scaffolded Yesod project uses this code:
data App = App
{ appSettings :: AppSettings
, appStatic :: Static -- ^ Settings for static file serving.
, appConnPool :: ConnectionPool -- ^ Database connection pool.
, appHttpManager :: Manager
, appLogger :: Logger
}
The example code you linked to does that as well:
data App = App
{ homepageContent :: Html
, visitorCount :: IORef Int
}
So what about something like this:
-- Small caveat: this is code untested
data App = App
{ backend :: SqlBackend
, chan :: TChan Text
}
main :: IO ()
main = do
chan <- newTChanIO
runNoLoggingT $ withSqliteConn "email.db3" $ \conn -> liftIO $ do
runSqlConn (runMigration migrateAll) conn
warp 3000 $ App { backend=conn, chan=chan}
You would have to change old code accessing your TChan, but once your App is a record, you can add more fields without making changes to the rest of your codebase.
As a side note, have you considered using the Yesod scaffolding? You'd start off with all this handled for you, with a bunch of other niceties and best practices already implemented for you.
I'm trying to use the cached function to prevent multiple db queries in different widgets and handlers:
newtype CachedBobId key
= CachedBobId { unCachedBobId :: key }
deriving Typeable
getBob' :: Handler BobId
getBob' = do
uncle <- runInputGet $ ireq textField "bobsuncle"
(Entity bob _) <- runDB $ getBy404 $ UniqueBob uncle
return bob
getBob :: Handler BobId
getBob = do
a <- getBob'
let b = return $ CachedBobId a
c <- cached b
return $ unCachedBobId c
And in a widget somewhere:
renderDerp :: Widget
renderDerp = do
--these are used in the shakespeare files
lolBob <- handlerToWidget $ getBob
nutherBob <- handlerToWidget $ getBob
$(widgetFile "test")
This compiles but the query to get the ID still runs multiple times.
What am I doing wrong? Or is there a better way to only get bob once and use him in every handler and widget?
I'm pretty new to Yesod, but I think you just need to tweak getBob
getBob :: Handler BobId
getBob = unCachedBobId <$> cached (CachedBobId <$> getBob')
The problem is that your current getBob function starts its do block with a <- getBob'. Remember that a do block sequences monadic actions, so you actually end up calling getBob' first thing every time getBob is called. In an ironic twist, after you've done this, you create a cached version of a handler which returns what you just got from getBob', but end up querying that cached version exactly once (right afterwards with c <- cached b), then it just falls out of scope and the garbage collector gets it.
In the solution I present above, you wrap whatever getBob' gives you in CachedBobId. Then, you pass that handler CachedBobId <$> getBob' :: Handler (CachedBobId BobId), to cached, which gives you back another handler cached (CachedBobId <$> getBob') of the same type, but with caching. Finally, you extract whatever the cached handler gives you to get back a Handler BobId.
Starting out with Haskell and Yesod, probably getting a bit too far with Yesod relative to Haskell :)
I build entities using Persistent via
share [mkPersist sqlSettings, mkMigrate "migrateAll"][persistLowerCase|
Game
title String
company String
UniqueTitle title
deriving Show
Tag
label String
description String Maybe
UniqueLabel label
deriving Show
GameTag
gameId GameId
tagId TagId
UniqueGameTag gameId tagId
|]
-- Yesod related code ...
In main I have
main :: IO ()
main = do
let taggings = fromFile :: [(Game, Tag)] -- fromFile code not included
runStderrLoggingT $ withSqlitePool ":inmemory:" 10 $ λpool → liftIO $ do
runResourceT $ flip runSqlPool pool $ do
runMigration migrateAll
let (g, t) = head taggings
gid ← insert g
tid ← insert t
insert (GameTag gid tid)
warp 3000 $ App pool
Doing this I get the first relation into the database, and by selecting elements from the list I can add more 'by hand', but I can't figure out how to get all the relations into the database by somehow iterating over taggings. How do i define a function that I can map over taggings ::[(Game, Tag)] and inserts the game tags of the type GameTag constructed
by Persistent?
The main trick here isn't in pulling out the function, that is easy:
f (g, t) = do
gid <- insert g
tid <- insert t
insert (GameTag gid tid)
The trick is knowing how to use this.... Standard map won't work alone, because the function is defined in a monad (you can use it, it will just give you a list of actions back without running them).
map f taggings -- returns just a list, type [ResourceT IO a], doesn't run anything
Here are two ways to actually run the actions from within main.
sequence (map f taggings) --sequentially runs the actions in the list
or, the more readable
forM taggings f
or, in the slightly more verbose
forM taggings $ \tagging -> do
f tagging
You also might want to look at mapM. Also also should learn about forM_ and sequence_ to supress the (often useless) return values.
I am using the LevelDB library and Snap framework together. I have:
main :: IO ()
main = runResourceT $ do
db <- open "thedb" defaultOptions { createIfMissing = True }
liftIO $ serveSnaplet defaultConfig $ initWeb db
Now in my handler, I'm unsure how to get back to MonadResource IO in order to query the database:
handleWords :: Handler App App ()
handleWords = do
words <- uses thedb $ \db -> $ get db def "words"
writeBS $ pack $ show words
Which gives me a: No instance for (MonadResource IO) arising from a use of 'get'
Any ideas? I feel like I'm missing something about how to properly create a monad "stack". Thanks
MonadResource/ResourceT is one way of acquiring scarce resources in a way that guarantees resources will be freed in the case of an exception. Another approach is the bracket pattern, which is supported by Snap via the bracketSnap function. You can use this to create the ResourceT context needed by LevelDB:
import qualified Control.Monad.Trans.Resource as Res
bracketSnap Res.createInternalState Res.closeInternalState $ \resState -> do
let openAction = open "thedb" defaultOptions { createIfMissing = True }
db <- Res.runInternalState openAction resState
This could be made simpler with some changes in Snap and leveldb:
Instead of only providing the open function, which presumes a MonadResource context, there could be a function which returns a Resource value. I'm making this tweak in persistent for the 2.0 release.
Snap could provide support for either MonadResource or the Resource monad (two separate concepts with unfortunately similar names).
Snap doesn't need to support MonadResource or Resource for you to do this. You're doing the monad transformer composition in the wrong direction. A look at the types will help.
serveSnaplet :: Config Snap AppConfig -> SnapletInit b b -> IO ()
runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a
So you're trying to put an IO in the place that a ResourceT is expected. You should approach this the other way around. Put your open "thedb" ... call inside your application's Initializer with a liftIO. But open is a MonadResource, so you need to use the ResourceT instance to get it into an IO. It will look something like this:
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
...
db <- liftIO $ runResourceT $ open "thedb" defaultOptions
Then store the db handle in your App state and you can retrieve it later using Handler's MonadReader or MonadState instances.
I've written a small server which accepts registrations as POST requests and persists them by appending them to a file. As soon as I put this server under load (I use Apache JMeter with 50 concurrent threads and a repeat count of 10, and the post consists of one field with ~7k of text data), I get lots of "resource busy, file is locked" errors:
02/Nov/2013:18:07:11 +0100 [Error#yesod-core] registrations.txt: openFile: resource busy (file is locked) #(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)
Here is a stripped-down version of the code:
{-# LANGUAGE QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings, TypeFamilies #-}
import Yesod
import Text.Hamlet
import Control.Applicative ((<$>), (<*>))
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text, pack, unpack)
import Data.String
import System.IO (withFile, IOMode(..), hPutStrLn)
data Server = Server
data Registration = Registration
{ text :: Text
}
deriving (Show, Read)
mkYesod "Server" [parseRoutes|
/reg RegR POST
|]
instance Yesod Server
instance RenderMessage Server FormMessage where
renderMessage _ _ = defaultFormMessage
postRegR :: Handler Html
postRegR = do
result <- runInputPost $ Registration
<$> ireq textField "text"
liftIO $ saveRegistration result
defaultLayout [whamlet|<p>#{show result}|]
saveRegistration :: Registration -> IO ()
saveRegistration r = withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)
main :: IO ()
main = warp 8080 Server
I compiled the code on purpose without -threaded, and the OS shows only a single thread running. Nonetheless it looks to me like the requests are not completely serialised, and a new request is already handled before the old one has been written to disk.
Could you tell me how I can avoid the error message and ensure that all requests are handled successfully? Performance is not an issue yet.
It's perfectly OK to write to a Handle from several threads. In fact, Handles have MVars inside them to prevent weird concurrent behaviour. What you probably want is not to handle [sic] MVars by hand (which can lead to deadlock if, for instance, a handler throws an exception) but lift the withFile call outside the individual handler threads. The file stays open all the time - opening it on each request would be slow anyway.
I don't know much about Yesod, but I'd recommend something like this (probably doesn't compile):
data Server = Server { handle :: Handle }
postRegR :: Handler Html
postRegR = do
h <- handle `fmap` getYesod
result <- runInputPost $ Registration
<$> ireq textField "text"
liftIO $ saveRegistration h result
defaultLayout [whamlet|<p>#{show result}|]
saveRegistration :: Handle -> Registration -> IO ()
saveRegistration h r = hPutStrLn h $ "+" ++ show r
main :: IO ()
main = withFile "registrations.txt" AppendMode $ \h -> warp 8080 (Server h)
-- maybe there's a better way?
Aside: if you wanted to file to be written asynchronously you could write to a queue (if it were a log file or something), but in your use case you probably want to let the user know if their registration failed, so I'd recommend staying with this form.
Even without -threaded the Haskell runtime will have several "green threads" running cooperatively. You need to use Control.Concurrent to limit access to the file because you cannot have several threads writing to it at once.
The easiest way is to have an MVar () in your Server and have each request "take" the unit from the MVar before opening the file and then put it back after the file operation has been completed. You can use bracket to ensure that the lock is released even if writing the file fails. E.g. something like
import Control.Concurrent
import Control.Exception (bracket_)
type Lock = MVar ()
data Server = Server { fileLock :: Lock }
saveRegistration :: Registration -> Lock -> IO ()
saveRegistration r lock = bracket_ acquire release updateFile where
acquire = takeMVar lock
release = putMVar lock ()
updateFile =
withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)