I have searched for a clear answer to this question but haven't been able to find one yet - How do I enable automatic logging of SQL statements being executed by persistent? Can someone give me a small example program for this?
Following is an example program that currently does not have logging. How do I enable logging in it?
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Person
name Text
status Text Maybe
deriving Show
|]
main :: IO ()
main = runSqlite ":memory:" $ do
runMigration migrateAll
insert (Person "Oliver Charles" Nothing)
insert (Person "Jon Snow" Nothing)
insert (Person "Marky Mark" (Just "helloo helloo"))
noStatusPeople >>= mapM_ (liftIO . print)
where
noStatusPeople =
select $ from $ \person -> do
where_ (person ^. PersonStatus ==. val Nothing)
return (person ^. PersonName)
You need to call your SQL code in a Monad that implements MonadLogger and not just IO. (see http://hackage.haskell.org/package/monad-logger-0.3.13.1/docs/Control-Monad-Logger.html#v:runStdoutLoggingT). However, runSqlite already sets up the logging (to none...) for you, so you need to use the lower level function withSqliteConn.
So for example, if you change your code to:
import Control.Monad.Logger
import Control.Monad.Trans.Resource
runResourceT $ runStdoutLoggingT $ withSqliteConn ":memory:" . runSqlConn $ do...
(with the proper dependencies on resourcet and monad-logger), you can have your SQL statement written to standard out.
As a real-life example, have a look at my scion-class-browser project:
in https://github.com/JPMoresmau/scion-class-browser/blob/5ab9c7576f8faf93299826e72defe70dd5b6dd6f/src/Server/PersistentCommands.hs#L93 you see the call to runSqlite. runLogging is a helper function, to switch between logging or no logging, defined in https://github.com/JPMoresmau/scion-class-browser/blob/f7f2ab0de4f4edb01b307411abf0aa951a3c7c48/src/Scion/PersistentBrowser/DbTypes.hs#L16 (the currently build version does not log, replace by the commented out code).
Of course, you can instead of using a simple dump to stdout or stderr, write your own implementation of MonadLogger that does what you want.
As a side note, your code doesn't print out the matching records because you shouldn't compare with val Nothing but instead use isNothing:
where_ (isNothing $ person ^. PersonStatus)
Related
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 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")
Im trying to get selectOneMany to work with limited success.
I have the following database models
User
email Text
verkey Text Maybe
verified Bool
password Text Maybe
UniqueUser email
date UTCTime
deriving Show
Competence
parent CompetenceId Maybe
title Text
UniqueCompetence title
deriving Show Read
UserCompetence
competence CompetenceId
user UserId Eq
UniqueUserCompetence user competence
deriving Show Read
code from my handler
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
user <- MaybeT . runDB . get . entityKey $ id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
return (member,competences)
first of; I cant event get this code to run without adding a big type-signature, is this as it should be?
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser :: SelectOneMany SqlPersist (UserGeneric SqlPersist) (UserCompetenceGeneric SqlPersist))
secondly; what is the type of competences. Ideally i want to end up with [Entity competenceId competence].
Lastly; How would one add a filter to the above join so as to only acquire competences for 'user'?
I have already told you that it's not possible to avoid the extra type signature due to the fact that SelectOneMany uses type aliases that might not be inductive; i.e. your code tries to be more polymorphic than it should be, and the type signature is necessary to restrict that polymorphism.
You can avoid using the huge signature by constraining the types "from a different angle", e.g.:
return (member, competences :: [(Entity User, [Entity UserCompetence])])
Since the type aliases User and UserCompetence select a specific database backend, the types should be resolved appropriately.
Also, I just spoiled the type of competences for you. Hah! I hope that that's enough for you. If you want a many-to-many three-table join directly so that you can get all competences "owned" by an user, you should use prepared statements anyways because of the potential AST overhead, so check out the generic raw SQL interface which lets you do the traditional "SELECT * FROM foo WHERE bar = ?" [filteredBarValue] which you might be more used to working with; it doesn't offer the same type safety as the rest of persistent but I think that it's the easiest way to implement three-table joins in your case.
You can restrict the Users that are selected by modifying the result of oneFilterMany which has type OneFilterMany. Like so (haven't tested it, but should work):
let join = (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
{ somFilterOne = [... filters for User ...] }
competences <- lift . runDB . runJoin $ join
Thanks to (lots of) help from dflemstr I ended up with
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
let user = entityVal id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
let competenceStatement =
Text.concat
[ "SELECT ?? "
, "FROM competence, user_competence "
, "WHERE competence.id = user_competence.competence_id "
, "AND ? = user_competence.user_id"
]
competences <- lift . runDB $ rawSql competenceStatement
[toPersistValue . entityKey $ id]
return (member, competences :: [Entity Competence])
I want to create a Happstack application with lots of access to a database. I think that a Monad Stack with IO at the bottom and a Database Write-like monad on top (with log writer in the middle) will work to have a clear functions in each access, example:
itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
methodM [GET,HEAD]
liftIO $ noticeM (scLogger cf) "sended job list"
items <- runDBMonad (scDBConnString cf) $ getItemLists
case items of
(Right xs) -> ok $ toResponse $ show xs
(Left err) -> internalServerError $ toResponse $ show err
With:
getItemList :: MyDBMonad (Error [Item])
getItemList = do
-- etc...
But I have little knowledge of Monad and Monad Transformers (I see this question as an exercise to learn about it), and I have no idea how to begin the creation of Database Monad, how to lift the IO from happstack to the Database Stack,...etc.
Here is some minimal working code compiled from snippets above for confused newbies like me.
You put stuff into AppConfig type and grab it with ask inside your response makers.
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C
myApp :: AppMonad Response
myApp = do
-- access app config. look mom, no lift!
test <- ask
-- try some happstack funs. no lift either.
rq <- askRq
bs <- lookBS "lol"
-- test IO please ignore
liftIO . print $ test
liftIO . print $ rq
liftIO . print $ bs
-- bye
ok $ toResponse ("Oh, hi!" :: C.ByteString)
-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
, appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []
type AppMonad = ReaderT AppConfig (ServerPartT IO)
main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}
You likely want to use 'ReaderT':
type MyMonad a = ReaderT DbHandle ServerPart a
The Reader monad transformer makes a single value accessible using the ask function - in this case, the value we want everyone to get at is the database connection.
Here, DbHandle is some connection to your database.
Because 'ReaderT' is already an instance of all of the happstack-server type-classes all normal happstack-server functions will work in this monad.
You probably also want some sort of helper to open and close the database connection:
runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
db <- liftIO $ connect_to_your_db connectionString
result <- runReaderT m db
liftIO $ close_your_db_connection db
(It might be better to use a function like 'bracket' here, but I don't know that there is such an operation for the ServerPart monad)
I don't know how you want to do logging - how do you plan to interact with your log-file? Something like:
type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a
and then:
askDb :: MyMonad DbHandle
askDb = fst <$> ask
askLogger :: MyMonad LogHandle
askLogger = snd <$> ask
might be enough. You could then build on those primitives to make higher-level functions. You would also need to change runMyMonad to be passed in a LogHandle, whatever that is.
Once you get more than two things you want access to it pays to have a proper record type instead of a tuple.
I'm trying to access mongo using the mongodb haskell drivers (the snap driver appears to be broken for snap > 0.5) in splice.
This is as far as I've got so far:
testSplice :: Splice AppHandler
testSplice = do
record <- liftIO $ do
pipe <- runIOE $ connect (host "127.0.0.1")
results <- access pipe master "db" (find $ select [] "coll")
close pipe
rest result
return $ [TextNode $ T.pack $ show $ records]
I understand that I need to use liftIO there, as the mongo action occurs inside an IO monad, and I want to pull that back out. Where my understanding breaks down is the result of compiling that splice:
Couldn't match expected type `IO a0'
with actual type `Action m0 [Database.MongoDB.Document]'
I'm sorry to post a "Send me the codes plz" question, but I'm at loss: where am I going wrong, and how do I make this work?
Here is your function annotated with type signatures. I think this makes it
pretty clear where the problem lies.
testSplice :: Splice AppHandler
testSplice = do
record <- liftIO $ do
pipe <- runIOE $ connect (host "127.0.0.1") -- :: IO Pipe
results <- access pipe master "db" (find $ select [] "coll")
-- ^ :: IO (Either Failure Cursor)
close pipe -- :: IO ()
rest result -- :: Action m [Document]
return $ [TextNode $ T.pack $ show $ records]
Everything inside the "liftIO $ do" block must be an IO action. The last line
"rest result" is not. One solution is to prepend that line with 'access pipe
master "db"' just like you've done with find. Another solution is to avoid
calling "access pipe..." twice and replace the find line with the following:
result <- access pipe master "db" (find (select [] "coll") >>= rest)
Then replace the "rest result" line with "return result"
What Daniel says about the find line not needing liftIO is correct, but in
this case it doesn't matter because IO has a MonadIO instance. So it's probably just as easy to keep all the liftIO stuff in one block.
I am not a MongoDB expert, so I'm not 100% sure (and I can't test it), but I suspect that you've got your liftIO in the wrong place. We have liftIO :: MonadIO m => IO a -> m a, so we should apply liftIO to actions that are actually IO, but which we want to be something bigger than IO. I suspect that access is a function with a bigger-than-IO return type. Assuming runIOE, close, and rest all actually have IO return types, we'd then do something like this:
testSplice = do
pipe <- liftIO . runIOE $ connect (host "127.0.0.1")
results <- access pipe master "db" (find $ select [] "coll") -- note: no liftIO on this one because it's presumably already lifted
liftIO $ close pipe
record <- liftIO $ rest result
return [TextNode . T.pack . show $ records]
If some of those actions actually are not IO things, then you can drop the liftIO from those ones.
As you observed, this can be cleaned up a bit: any adjacent lines that start with liftIO can be coalesced. So if the above turns out to be the right places for liftIOs, then it could also be written as:
testSplice = do
pipe <- liftIO . runIOE $ connect (host "127.0.0.1")
results <- access pipe master "db" (find $ select [] "coll")
liftIO $ do
close pipe
record <- rest result
return [TextNode . T.pack . show $ records]
(The last one there is OK because return = liftIO . return for any sane implementation of liftIO.)