Safe Haskell | None |
---|---|
Language | Haskell2010 |
This snaplet makes it simple to use a PostgreSQL database from your Snap application and is based on the excellent postgresql-simple library (http://hackage.haskell.org/package/postgresql-simple) by Leon Smith (adapted from Bryan O'Sullivan's mysql-simple). Now, adding a database to your web app takes just two simple steps.
First, include this snaplet in your application's state.
data App = App { ... -- Other state needed in your app , _db :: Snaplet Postgres }
Next, call the pgsInit from your application's initializer.
appInit = makeSnaplet ... $ do ... d <- nestSnaplet "db" db pgsInit return $ App ... d
Now you can use any of the postgresql-simple wrapper functions defined in this module anywhere in your application handlers. For instance:
postHandler :: Handler App App () postHandler = do posts <- with db $ query_ "select * from blog_post" ...
Optionally, if you find yourself doing many database queries, you can eliminate some of the boilerplate by defining a HasPostgres instance for your application.
instance HasPostgres (Handler b App) where getPostgresState = with db get setLocalPostgresState s = local (set (db . snapletValue) s)
With this code, our postHandler example no longer requires the with
function:
postHandler :: Handler App App () postHandler = do posts <- query_ "select * from blog_post" ...
If you have code that runs multiple queries but you want to make sure that you only use one database connection then you can use the withPG function, like so:
postHandler :: Handler App App () postHandler = withPG $ do posts <- query_ "select * from blog_post" links <- query_ "select * from links" ...
The first time you run an application with the postgresql-simple snaplet, a
configuration file devel.cfg
is created in the snaplets/postgresql-simple
directory underneath your project root. It specifies how to connect to your
PostgreSQL server and what user, password, and database to use. Edit this
file and modify the values appropriately and you'll be off and running.
If you want to have out-of-the-box authentication, look at the documentation for the Snap.Snaplet.Auth.Backends.PostgresqlSimple module.
Synopsis
- data Postgres
- class (MonadIO m, MonadBaseControl IO m) => HasPostgres m where
- getPostgresState :: m Postgres
- setLocalPostgresState :: Postgres -> m a -> m a
- data PGSConfig = PGSConfig {}
- pgsDefaultConfig :: ByteString -> PGSConfig
- mkPGSConfig :: MonadIO m => Config -> m PGSConfig
- pgsInit :: SnapletInit b Postgres
- pgsInit' :: PGSConfig -> SnapletInit b Postgres
- getConnectionString :: Config -> IO ByteString
- withPG :: HasPostgres m => m b -> m b
- data Connection
- liftPG :: HasPostgres m => (Connection -> m a) -> m a
- liftPG' :: HasPostgres m => (Connection -> IO b) -> m b
- query :: (HasPostgres m, ToRow q, FromRow r) => Query -> q -> m [r]
- query_ :: (HasPostgres m, FromRow r) => Query -> m [r]
- fold :: (HasPostgres m, FromRow row, ToRow params) => Query -> params -> b -> (b -> row -> IO b) -> m b
- foldWithOptions :: (HasPostgres m, FromRow row, ToRow params) => FoldOptions -> Query -> params -> b -> (b -> row -> IO b) -> m b
- fold_ :: (HasPostgres m, FromRow row) => Query -> b -> (b -> row -> IO b) -> m b
- foldWithOptions_ :: (HasPostgres m, FromRow row) => FoldOptions -> Query -> b -> (b -> row -> IO b) -> m b
- forEach :: (HasPostgres m, FromRow r, ToRow q) => Query -> q -> (r -> IO ()) -> m ()
- forEach_ :: (HasPostgres m, FromRow r) => Query -> (r -> IO ()) -> m ()
- execute :: (HasPostgres m, ToRow q) => Query -> q -> m Int64
- execute_ :: HasPostgres m => Query -> m Int64
- executeMany :: (HasPostgres m, ToRow q) => Query -> [q] -> m Int64
- returning :: (HasPostgres m, ToRow q, FromRow r) => Query -> [q] -> m [r]
- withTransaction :: HasPostgres m => m a -> m a
- withTransactionLevel :: HasPostgres m => IsolationLevel -> m a -> m a
- withTransactionMode :: HasPostgres m => TransactionMode -> m a -> m a
- withTransactionEither :: HasPostgres m => m (Either a b) -> m (Either a b)
- withTransactionModeEither :: HasPostgres m => TransactionMode -> m (Either a b) -> m (Either a b)
- formatMany :: (ToRow q, HasPostgres m) => Query -> [q] -> m ByteString
- formatQuery :: (ToRow q, HasPostgres m) => Query -> q -> m ByteString
- data Query
- newtype In a = In a
- newtype Binary a = Binary {
- fromBinary :: a
- newtype Only a = Only {
- fromOnly :: a
- data SqlError = SqlError {}
- data FormatError = FormatError {
- fmtMessage :: String
- fmtQuery :: Query
- fmtParams :: [ByteString]
- data QueryError = QueryError {}
- data ResultError
- = Incompatible { }
- | UnexpectedNull { }
- | ConversionFailed { }
- data TransactionMode = TransactionMode {}
- data IsolationLevel
- data ReadWriteMode
- begin :: Connection -> IO ()
- beginLevel :: IsolationLevel -> Connection -> IO ()
- beginMode :: TransactionMode -> Connection -> IO ()
- rollback :: Connection -> IO ()
- commit :: Connection -> IO ()
- data h :. t = h :. t
- class ToRow a where
- class FromRow a where
- defaultConnectInfo :: ConnectInfo
- defaultTransactionMode :: TransactionMode
- defaultIsolationLevel :: IsolationLevel
- defaultReadWriteMode :: ReadWriteMode
- field :: FromField a => RowParser a
The Snaplet
The state for the postgresql-simple snaplet. To use it in your app include this in your application state and use pgsInit to initialize it.
Instances
HasPostgres (Handler b Postgres) Source # | Default instance |
Defined in Snap.Snaplet.PostgresqlSimple | |
(MonadIO m, MonadBaseControl IO m) => HasPostgres (ReaderT (Snaplet Postgres) m) Source # | A convenience instance to make it easier to use this snaplet in the Initializer monad like this: d <- nestSnaplet "db" db pgsInit count <- liftIO $ runReaderT (execute "INSERT ..." params) d |
(MonadIO m, MonadBaseControl IO m) => HasPostgres (ReaderT Postgres m) Source # | A convenience instance to make it easier to use functions written for this snaplet in non-snaplet contexts. |
Defined in Snap.Snaplet.PostgresqlSimple |
class (MonadIO m, MonadBaseControl IO m) => HasPostgres m where Source #
Instantiate this typeclass on 'Handler b YourAppState' so this snaplet
can find the connection source. If you need to have multiple instances of
the postgres snaplet in your application, then don't provide this instance
and leverage the default instance by using "with dbLens
" in front of calls
to snaplet-postgresql-simple functions.
getPostgresState :: m Postgres Source #
setLocalPostgresState :: Postgres -> m a -> m a Source #
Instances
Data type holding all the snaplet's config information.
PGSConfig | |
|
:: ByteString | A connection string such as "host=localhost port=5432 dbname=mydb" |
-> PGSConfig |
Returns a config object with default values and the specified connection string.
mkPGSConfig :: MonadIO m => Config -> m PGSConfig Source #
Builds a PGSConfig object from a configurator Config object. This function uses getConnectionString to construct the connection string. The rest of the PGSConfig fields are obtained from "numStripes", "idleTime", and "maxResourcesPerStripe".
pgsInit :: SnapletInit b Postgres Source #
Initialize the snaplet
pgsInit' :: PGSConfig -> SnapletInit b Postgres Source #
Initialize the snaplet using a specific configuration.
getConnectionString :: Config -> IO ByteString Source #
Produce a connection string from a config
withPG :: HasPostgres m => m b -> m b Source #
Function that reserves a single connection for the duration of the given action. Nested calls to withPG will only reserve one connection. For example, the following code calls withPG twice in a nested way yet only results in a single connection being reserved:
myHandler = withPG $ do queryTheDatabase commonDatabaseMethod commonDatabaseMethod = withPG $ do moreDatabaseActions evenMoreDatabaseActions
This is useful in a practical setting because you may often find yourself in a situation where you have common code (that requires a database connection) that you wish to call from other blocks of code that may require a database connection and you still want to make sure that you are only using one connection through all of your nested methods.
data Connection #
Instances
Eq Connection | |
Defined in Database.PostgreSQL.Simple.Internal (==) :: Connection -> Connection -> Bool # (/=) :: Connection -> Connection -> Bool # |
liftPG :: HasPostgres m => (Connection -> m a) -> m a Source #
Convenience function for executing a function that needs a database connection.
liftPG' :: HasPostgres m => (Connection -> IO b) -> m b Source #
Convenience function for executing a function that needs a database connection specialized to IO.
Wrappers and re-exports
fold :: (HasPostgres m, FromRow row, ToRow params) => Query -> params -> b -> (b -> row -> IO b) -> m b Source #
foldWithOptions :: (HasPostgres m, FromRow row, ToRow params) => FoldOptions -> Query -> params -> b -> (b -> row -> IO b) -> m b Source #
foldWithOptions_ :: (HasPostgres m, FromRow row) => FoldOptions -> Query -> b -> (b -> row -> IO b) -> m b Source #
executeMany :: (HasPostgres m, ToRow q) => Query -> [q] -> m Int64 Source #
withTransaction :: HasPostgres m => m a -> m a Source #
Be careful that you do not call Snap's finishWith
function anywhere
inside the function that you pass to withTransaction
. Doing so has been
known to cause DB connection leaks.
withTransactionLevel :: HasPostgres m => IsolationLevel -> m a -> m a Source #
Be careful that you do not call Snap's finishWith
function anywhere
inside the function that you pass to withTransactionLevel
. Doing so has
been known to cause DB connection leaks.
withTransactionMode :: HasPostgres m => TransactionMode -> m a -> m a Source #
Be careful that you do not call Snap's finishWith
function anywhere
inside the function that you pass to withTransactionMode
. Doing so has
been known to cause DB connection leaks.
withTransactionEither :: HasPostgres m => m (Either a b) -> m (Either a b) Source #
Be careful that you do not call Snap's finishWith
function anywhere
inside the function that you pass to withTransactionMode
. Doing so has
been known to cause DB connection leaks.
withTransactionModeEither :: HasPostgres m => TransactionMode -> m (Either a b) -> m (Either a b) Source #
Be careful that you do not call Snap's finishWith
function anywhere
inside the function that you pass to withTransactionMode
. Doing so has
been known to cause DB connection leaks.
formatMany :: (ToRow q, HasPostgres m) => Query -> [q] -> m ByteString Source #
formatQuery :: (ToRow q, HasPostgres m) => Query -> q -> m ByteString Source #
A query string. This type is intended to make it difficult to construct a SQL query by concatenating string fragments, as that is an extremely common way to accidentally introduce SQL injection vulnerabilities into an application.
This type is an instance of IsString
, so the easiest way to
construct a query is to enable the OverloadedStrings
language
extension and then simply write the query in double quotes.
{-# LANGUAGE OverloadedStrings #-} import Database.PostgreSQL.Simple q :: Query q = "select ?"
The underlying type is a ByteString
, and literal Haskell strings
that contain Unicode characters will be correctly transformed to
UTF-8.
Wrap a list of values for use in an IN
clause. Replaces a
single "?
" character with a parenthesized list of rendered
values.
Example:
query c "select * from whatever where id in ?" (Only (In [3,4,5]))
Note that In []
expands to (null)
, which works as expected in
the query above, but evaluates to the logical null value on every
row instead of TRUE
. This means that changing the query above
to ... id NOT in ?
and supplying the empty list as the parameter
returns zero rows, instead of all of them as one would expect.
Since postgresql doesn't seem to provide a syntax for actually specifying an empty list, which could solve this completely, there are two workarounds particularly worth mentioning, namely:
Use postgresql-simple's
Values
type instead, which can handle the empty case correctly. Note however that while specifying the postgresql type"int4"
is mandatory in the empty case, specifying the haskell typeValues (Only Int)
would not normally be needed in realistic use cases.query c "select * from whatever where id not in ?" (Only (Values ["int4"] [] :: Values (Only Int)))
Use sql's
COALESCE
operator to turn a logicalnull
into the correct boolean. Note however that the correct boolean depends on the use case:query c "select * from whatever where coalesce(id NOT in ?, TRUE)" (Only (In [] :: In [Int]))
query c "select * from whatever where coalesce(id IN ?, FALSE)" (Only (In [] :: In [Int]))
Note that at as of PostgreSQL 9.4, the query planner cannot see inside the
COALESCE
operator, so if you have an index onid
then you probably don't want to write the last example withCOALESCE
, which would result in a table scan. There are further caveats ifid
can be null or you want null treated sensibly as a component ofIN
orNOT IN
.
In a |
Wrap binary data for use as a bytea
value.
Binary | |
|
Instances
Functor Binary | |
Eq a => Eq (Binary a) | |
Ord a => Ord (Binary a) | |
Defined in Database.PostgreSQL.Simple.Types | |
Read a => Read (Binary a) | |
Show a => Show (Binary a) | |
FromField (Binary ByteString) | bytea |
Defined in Database.PostgreSQL.Simple.FromField | |
FromField (Binary ByteString) | bytea |
Defined in Database.PostgreSQL.Simple.FromField | |
ToField (Binary ByteString) | |
Defined in Database.PostgreSQL.Simple.ToField toField :: Binary ByteString -> Action # | |
ToField (Binary ByteString) | |
Defined in Database.PostgreSQL.Simple.ToField toField :: Binary ByteString -> Action # |
The 1-tuple type or single-value "collection".
This type is structurally equivalent to the
Identity
type, but its intent is more
about serving as the anonymous 1-tuple type missing from Haskell for attaching
typeclass instances.
Parameter usage example:
encodeSomething (Only
(42::Int))
Result usage example:
xs <- decodeSomething
forM_ xs $ \(Only
id) -> {- ... -}
Instances
Functor Only | |
Eq a => Eq (Only a) | |
Data a => Data (Only a) | |
Defined in Data.Tuple.Only gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Only a -> c (Only a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Only a) # toConstr :: Only a -> Constr # dataTypeOf :: Only a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Only a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Only a)) # gmapT :: (forall b. Data b => b -> b) -> Only a -> Only a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only a -> r # gmapQ :: (forall d. Data d => d -> u) -> Only a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Only a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Only a -> m (Only a) # | |
Ord a => Ord (Only a) | |
Read a => Read (Only a) | |
Show a => Show (Only a) | |
Generic (Only a) | |
NFData a => NFData (Only a) | |
Defined in Data.Tuple.Only | |
FromField a => FromRow (Maybe (Only a)) | |
FromField a => FromRow (Only a) | |
Defined in Database.PostgreSQL.Simple.FromRow | |
ToField a => ToRow (Only a) | |
Defined in Database.PostgreSQL.Simple.ToRow | |
type Rep (Only a) | |
Defined in Data.Tuple.Only |
Instances
Eq SqlError | |
Show SqlError | |
Exception SqlError | |
Defined in Database.PostgreSQL.Simple.Internal toException :: SqlError -> SomeException # fromException :: SomeException -> Maybe SqlError # displayException :: SqlError -> String # |
data FormatError #
Exception thrown if a Query
could not be formatted correctly.
This may occur if the number of '?
' characters in the query
string does not match the number of parameters provided.
FormatError | |
|
Instances
Eq FormatError | |
Defined in Database.PostgreSQL.Simple.Internal (==) :: FormatError -> FormatError -> Bool # (/=) :: FormatError -> FormatError -> Bool # | |
Show FormatError | |
Defined in Database.PostgreSQL.Simple.Internal showsPrec :: Int -> FormatError -> ShowS # show :: FormatError -> String # showList :: [FormatError] -> ShowS # | |
Exception FormatError | |
Defined in Database.PostgreSQL.Simple.Internal |
data QueryError #
Exception thrown if query
is used to perform an INSERT
-like
operation, or execute
is used to perform a SELECT
-like operation.
Instances
Eq QueryError | |
Defined in Database.PostgreSQL.Simple.Internal (==) :: QueryError -> QueryError -> Bool # (/=) :: QueryError -> QueryError -> Bool # | |
Show QueryError | |
Defined in Database.PostgreSQL.Simple.Internal showsPrec :: Int -> QueryError -> ShowS # show :: QueryError -> String # showList :: [QueryError] -> ShowS # | |
Exception QueryError | |
Defined in Database.PostgreSQL.Simple.Internal toException :: QueryError -> SomeException # fromException :: SomeException -> Maybe QueryError # displayException :: QueryError -> String # |
data ResultError #
Exception thrown if conversion from a SQL value to a Haskell value fails.
Incompatible | The SQL and Haskell types are not compatible. |
| |
UnexpectedNull | A SQL |
| |
ConversionFailed | The SQL value could not be parsed, or could not be represented as a valid Haskell value, or an unexpected low-level error occurred (e.g. mismatch between metadata and actual data in a row). |
|
Instances
Eq ResultError | |
Defined in Database.PostgreSQL.Simple.FromField (==) :: ResultError -> ResultError -> Bool # (/=) :: ResultError -> ResultError -> Bool # | |
Show ResultError | |
Defined in Database.PostgreSQL.Simple.FromField showsPrec :: Int -> ResultError -> ShowS # show :: ResultError -> String # showList :: [ResultError] -> ShowS # | |
Exception ResultError | |
Defined in Database.PostgreSQL.Simple.FromField |
data TransactionMode #
Instances
Eq TransactionMode | |
Defined in Database.PostgreSQL.Simple.Transaction (==) :: TransactionMode -> TransactionMode -> Bool # (/=) :: TransactionMode -> TransactionMode -> Bool # | |
Show TransactionMode | |
Defined in Database.PostgreSQL.Simple.Transaction showsPrec :: Int -> TransactionMode -> ShowS # show :: TransactionMode -> String # showList :: [TransactionMode] -> ShowS # |
data IsolationLevel #
Of the four isolation levels defined by the SQL standard,
these are the three levels distinguished by PostgreSQL as of version 9.0.
See https://www.postgresql.org/docs/9.5/static/transaction-iso.html
for more information. Note that prior to PostgreSQL 9.0, RepeatableRead
was equivalent to Serializable
.
DefaultIsolationLevel | the isolation level will be taken from
PostgreSQL's per-connection
|
ReadCommitted | |
RepeatableRead | |
Serializable |
Instances
data ReadWriteMode #
DefaultReadWriteMode | the read-write mode will be taken from
PostgreSQL's per-connection
|
ReadWrite | |
ReadOnly |
Instances
begin :: Connection -> IO () #
Begin a transaction.
beginLevel :: IsolationLevel -> Connection -> IO () #
Begin a transaction with a given isolation level
beginMode :: TransactionMode -> Connection -> IO () #
Begin a transaction with a given transaction mode
rollback :: Connection -> IO () #
Rollback a transaction.
commit :: Connection -> IO () #
Commit a transaction.
A composite type to parse your custom data structures without having to define dummy newtype wrappers every time.
instance FromRow MyData where ...
instance FromRow MyData2 where ...
then I can do the following for free:
res <- query' c "..." forM res $ \(MyData{..} :. MyData2{..}) -> do ....
h :. t infixr 3 |
Instances
(Eq h, Eq t) => Eq (h :. t) | |
(Ord h, Ord t) => Ord (h :. t) | |
Defined in Database.PostgreSQL.Simple.Types | |
(Read h, Read t) => Read (h :. t) | |
(Show h, Show t) => Show (h :. t) | |
(FromRow a, FromRow b) => FromRow (a :. b) | |
Defined in Database.PostgreSQL.Simple.FromRow | |
(ToRow a, ToRow b) => ToRow (a :. b) | |
Defined in Database.PostgreSQL.Simple.ToRow |
A collection type that can be turned into a list of rendering
Action
s.
Instances should use the toField
method of the ToField
class
to perform conversion of each element of the collection.
You can derive ToRow
for your data type using GHC generics, like this:
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic
) import Database.PostgreSQL.Simple (ToRow
) data User = User { name :: String, fileQuota :: Int } deriving (Generic
,ToRow
)
Note that this only works for product types (e.g. records) and does not support sum types or recursive types.
Nothing
Instances
A collection type that can be converted from a sequence of fields. Instances are provided for tuples up to 10 elements and lists of any length.
Note that instances can be defined outside of postgresql-simple, which is often useful. For example, here's an instance for a user-defined pair:
data User = User { name :: String, fileQuota :: Int } instanceFromRow
User where fromRow = User <$>field
<*>field
The number of calls to field
must match the number of fields returned
in a single row of the query result. Otherwise, a ConversionFailed
exception will be thrown.
You can also derive FromRow
for your data type using GHC generics, like
this:
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} import GHC.Generics (Generic
) import Database.PostgreSQL.Simple (FromRow
) data User = User { name :: String, fileQuota :: Int } deriving (Generic
,FromRow
)
Note that this only works for product types (e.g. records) and does not support sum types or recursive types.
Note that field
evaluates its result to WHNF, so the caveats listed in
mysql-simple and very early versions of postgresql-simple no longer apply.
Instead, look at the caveats associated with user-defined implementations
of fromField
.
Nothing
Instances
defaultConnectInfo :: ConnectInfo #
Default information for setting up a connection.
Defaults are as follows:
- Server on
localhost
- Port on
5432
- User
postgres
- No password
- Database
postgres
Use as in the following example:
connect defaultConnectInfo { connectHost = "db.example.com" }
Orphan instances
HasPostgres (Handler b Postgres) Source # | Default instance |
(MonadIO m, MonadBaseControl IO m) => HasPostgres (ReaderT (Snaplet Postgres) m) Source # | A convenience instance to make it easier to use this snaplet in the Initializer monad like this: d <- nestSnaplet "db" db pgsInit count <- liftIO $ runReaderT (execute "INSERT ..." params) d |
(MonadIO m, MonadBaseControl IO m) => HasPostgres (ReaderT Postgres m) Source # | A convenience instance to make it easier to use functions written for this snaplet in non-snaplet contexts. |