Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Loading…

PgAction interface, fixing #6 #8

Open
wants to merge 2 commits into from

4 participants

@sopvop

Implemented module as proposed by me in #6.

I'm not sure about module name though.

@amontague

Could query, execute, etc be exported doing the withPostgres already, like the original API does? Is there any downside to that?

@sopvop

The original api is still there, so if you don't use transactions, you can still use it.

@mightybyte
Owner

@sopvop This looks pretty nice. It makes me think maybe we should just switch wholesale and not worry about backwards compatibility. What do you think?

@sopvop

@mightybyte It may be too big change for many users, but I wont mind it myself. And transaction functions should be removed from old api anyway.

I think we should wait a few days for other opinions on this. Maybe someone will come up with even better solution.

@sopvop

So, no new ideas, lets break things!
Since @amontague, and possibly others, want old functionality, we should keep it.
Should I make prefixed/suffixed functions with embedded 'withPostgres'? What would be good suffix/prefix for it?
Or put "old" interface into other module, for compatibility? I can't make up a good name for such module, 'Simple' would be good name, but PostgresqlSimple.Simple does not sound nice.
Of course all transaction functions should be removed.

@mightybyte
Owner

I found some time to work on this yesterday. My current thought is to see if I can merge this idea with what I did here mightybyte/postgresql-simple@ac280e7. I sent that as a pull request to postgresql-simple, but it hasn't been merged yet.

@sopvop

@lpsmith complained about lack of time few months ago, there are a lot of stuff in 0.3 branch of postgresql-simple waiting for cleanup and release.

@lpsmith

Well, at this point I mostly want to get what I want done in terms of overhauling the typeinfo stuff and push it out the door. But yes, if somebody wants to play around with the 0.3 branch, I'm definitely interested in hearing feedback.

You never sent me a proper pull request, mightybyte; at this point I'm inclined to adopt your suggestion as soon as we can find an acceptable MonadCatchIO alternative and generalize things a bit more appropriately. I've found that, for example, the (... -> IO ...) -> m ... shortcut on e.g. fold just really isn't so terribly useful.

Though what if you removed those functions from your wrapper?

@sopvop

@lpsmith how about monad-control? snap is switching to it from MonadCatchIO

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Commits on Nov 19, 2012
  1. @sopvop

    Switch to lens

    sopvop authored
  2. @sopvop

    Added Action module

    sopvop authored
This page is out of date. Refresh to see the latest.
View
1  snaplet-postgresql-simple.cabal
@@ -29,6 +29,7 @@ Library
exposed-modules:
Snap.Snaplet.PostgresqlSimple
+ Snap.Snaplet.PostgresqlSimple.Action
Snap.Snaplet.Auth.Backends.PostgresqlSimple
other-modules:
View
4 src/Snap/Snaplet/Auth/Backends/PostgresqlSimple.hs
@@ -67,7 +67,7 @@ data PostgresAuthManager = PostgresAuthManager
-- | Initializer for the postgres backend to the auth snaplet.
--
initPostgresAuth
- :: Lens b (Snaplet SessionManager) -- ^ Lens to the session snaplet
+ :: SnapletLens b SessionManager -- ^ Lens to the session snaplet
-> Snaplet Postgres -- ^ The postgres snaplet
-> SnapletInit b (AuthManager b)
initPostgresAuth sess db = makeSnaplet "postgresql-auth" desc datadir $ do
@@ -77,7 +77,7 @@ initPostgresAuth sess db = makeSnaplet "postgresql-auth" desc datadir $ do
key <- liftIO $ getKey (asSiteKey authSettings)
let tableDesc = defAuthTable { tblName = authTable }
let manager = PostgresAuthManager tableDesc $
- pgPool $ getL snapletValue db
+ pgPool $ db^#snapletValue
liftIO $ createTableIfMissing manager
rng <- liftIO mkRNG
return $ AuthManager
View
2  src/Snap/Snaplet/PostgresqlSimple.hs
@@ -164,7 +164,7 @@ instance HasPostgres (Handler b Postgres) where
-- > d <- nestSnaplet "db" db pgsInit
-- > count <- liftIO $ runReaderT (execute "INSERT ..." params) d
instance (MonadCatchIO m) => HasPostgres (ReaderT (Snaplet Postgres) m) where
- getPostgresState = asks (getL snapletValue)
+ getPostgresState = asks (\pgsnaplet -> pgsnaplet^#snapletValue)
------------------------------------------------------------------------------
View
189 src/Snap/Snaplet/PostgresqlSimple/Action.hs
@@ -0,0 +1,189 @@
+{-|
+
+This module provides alternative interface to Postgres Snaplet and is intented
+to provide safer usage of transactions.
+
+Setup your snaplet as in "Snap.Snaplet.PostgresqlSimple" and in handler use
+'withPostgres' or 'withPgTransaction'.
+
+-}
+
+module Snap.Snaplet.PostgresqlSimple.Action
+ ( PgAction
+ , withPostgres
+ , withPgTransaction
+ -- * Query wrappers
+ , query
+ , query_
+ , execute
+ , execute_
+ , executeMany
+ , returning
+ -- * Transactions
+ , begin
+ , beginLevel
+ , beginMode
+ , rollback
+ , commit
+ , withTransaction
+ , withTransactionLevel
+ , withTransactionMode
+ -- * Folds
+ , fold
+ , foldWithOptions
+ , fold_
+ , foldWithOptions_
+ , forEach
+ , forEach_
+ -- * Debugging helpers
+ , formatMany
+ , formatQuery
+ -- * Re-exported from postgresql-simple
+ , P.ConnectInfo(..)
+ , P.Query
+ , P.In(..)
+ , P.Binary(..)
+ , P.Only(..)
+ , P.SqlError(..)
+ , P.FormatError(..)
+ , P.QueryError(..)
+ , P.ResultError(..)
+ , P.TransactionMode(..)
+ , P.IsolationLevel(..)
+ , P.ReadWriteMode(..)
+ , (P.:.)(..)
+ , ToRow
+ , FromRow
+
+ , P.defaultConnectInfo
+ , P.defaultTransactionMode
+ , P.defaultIsolationLevel
+ , P.defaultReadWriteMode
+ ) where
+
+import Control.Monad (liftM)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Trans.Reader
+import Control.Monad.CatchIO (MonadCatchIO, onException)
+import Data.ByteString (ByteString)
+import Data.Int (Int64)
+import Data.Pool (withResource)
+import Database.PostgreSQL.Simple (FromRow, ToRow, Query)
+import qualified Database.PostgreSQL.Simple as P
+
+import Snap.Snaplet.PostgresqlSimple (HasPostgres(..),pgPool)
+
+type PgAction m a = ReaderT P.Connection m a
+
+
+withPostgres :: HasPostgres m => PgAction m a -> m a
+withPostgres act = do
+ pool <- liftM pgPool getPostgresState
+ withResource pool $ runReaderT act
+
+
+withPgTransaction :: HasPostgres m => PgAction m a -> m a
+withPgTransaction = withPostgres . withTransaction
+
+
+query :: (ToRow q, FromRow r, MonadIO m) => Query -> q -> PgAction m [r]
+query q p = ask >>= \c -> liftIO $ P.query c q p
+
+
+query_ :: (FromRow r, MonadIO m) => Query -> PgAction m [r]
+query_ q = ask >>= \c -> liftIO $ P.query_ c q
+
+
+execute :: (ToRow q, MonadIO m) => Query -> q -> PgAction m Int64
+execute q p = ask >>= \c -> liftIO $ P.execute c q p
+
+
+execute_ :: (MonadIO m) => Query -> PgAction m Int64
+execute_ q = ask >>= \c -> liftIO $ P.execute_ c q
+
+
+executeMany :: (ToRow q, MonadIO m) => Query -> [q] -> PgAction m Int64
+executeMany q ps = ask >>= \c -> liftIO $ P.executeMany c q ps
+
+
+returning :: (ToRow q, FromRow r, MonadIO m) => Query -> [q] -> PgAction m [r]
+returning q ps = ask >>= \c -> liftIO $ P.returning c q ps
+
+
+begin :: MonadIO m => PgAction m ()
+begin = ask >>= \c -> liftIO $ P.begin c
+
+
+beginLevel :: MonadIO m => P.IsolationLevel -> PgAction m ()
+beginLevel l = ask >>= \c -> liftIO $ P.beginLevel l c
+
+
+beginMode :: MonadIO m => P.TransactionMode -> PgAction m ()
+beginMode m = ask >>= \c -> liftIO $ P.beginMode m c
+
+
+rollback :: MonadIO m => PgAction m ()
+rollback = ask >>= \c -> liftIO $ P.rollback c
+
+
+commit :: MonadIO m => PgAction m ()
+commit = ask >>= \c -> liftIO $ P.commit c
+
+
+withTransactionMode :: MonadCatchIO m =>
+ P.TransactionMode -> PgAction m a -> PgAction m a
+withTransactionMode m act = do
+ beginMode m
+ r <- act `onException` rollback
+ commit
+ return r
+
+
+withTransactionLevel :: MonadCatchIO m =>
+ P.IsolationLevel -> PgAction m a -> PgAction m a
+withTransactionLevel l =
+ withTransactionMode P.defaultTransactionMode { P.isolationLevel = l }
+
+
+withTransaction :: MonadCatchIO m => PgAction m a -> PgAction m a
+withTransaction = withTransactionMode P.defaultTransactionMode
+
+
+formatMany :: (ToRow q, MonadIO m) => Query -> [q] -> PgAction m ByteString
+formatMany q ps = ask >>= \c -> liftIO $ P.formatMany c q ps
+
+
+formatQuery :: (ToRow q, MonadIO m) => Query -> q -> PgAction m ByteString
+formatQuery q p = ask >>= \c -> liftIO $ P.formatQuery c q p
+
+
+fold :: (ToRow p, FromRow r, MonadIO m) =>
+ Query -> p -> b -> (b -> r -> IO b) -> PgAction m b
+fold q ps a f = ask >>= \c -> liftIO $ P.fold c q ps a f
+
+
+fold_ :: (FromRow r, MonadIO m) =>
+ Query -> b -> (b -> r -> IO b) -> PgAction m b
+fold_ q a f = ask >>= \c -> liftIO $ P.fold_ c q a f
+
+
+foldWithOptions :: (ToRow p, FromRow r, MonadIO m) =>
+ P.FoldOptions -> Query -> p -> b -> (b -> r -> IO b) -> PgAction m b
+foldWithOptions opts q p a f =
+ ask >>= \c -> liftIO $ P.foldWithOptions opts c q p a f
+
+
+foldWithOptions_ :: (FromRow r, MonadIO m) =>
+ P.FoldOptions -> Query -> b -> (b -> r -> IO b) -> PgAction m b
+foldWithOptions_ opts q a f =
+ ask >>= \c -> liftIO $ P.foldWithOptions_ opts c q a f
+
+
+forEach :: (ToRow p, FromRow r, MonadIO m) =>
+ Query -> p -> (r -> IO ()) -> PgAction m ()
+forEach q p f = ask >>= \c -> liftIO $ P.forEach c q p f
+
+
+forEach_ :: (FromRow r, MonadIO m) =>
+ Query -> (r -> IO ()) -> PgAction m ()
+forEach_ q f = ask >>= \c -> liftIO $ P.forEach_ c q f
Something went wrong with that request. Please try again.