Safe Haskell | None |
---|---|
Language | Haskell2010 |
PgNamed
Contents
Description
Introduces named parameters for postgresql-simple
library.
It uses ?
question mark symbol as the indicator of the named parameter which
is replaced with the standard syntax with question marks.
Check out the example of usage:
queryNamed
[sql| SELECT * FROM users WHERE foo = ?foo AND bar = ?bar AND baz = ?foo |] [ "foo"=?
"fooBar" , "bar"=?
"barVar" ]
Synopsis
- data NamedParam = NamedParam {
- namedParamName :: !Name
- namedParamParam :: !Action
- newtype Name = Name {}
- (=?) :: ToField a => Name -> a -> NamedParam
- data PgNamedError
- type WithNamedError = MonadError PgNamedError
- extractNames :: Query -> Either PgNamedError (Query, NonEmpty Name)
- namesToRow :: forall m. WithNamedError m => NonEmpty Name -> [NamedParam] -> m (NonEmpty Action)
- queryNamed :: (MonadIO m, WithNamedError m, FromRow res) => Connection -> Query -> [NamedParam] -> m [res]
- executeNamed :: (MonadIO m, WithNamedError m) => Connection -> Query -> [NamedParam] -> m Int64
Named data types and smart constructors
data NamedParam Source #
Data type to represent each named parameter.
Constructors
NamedParam | |
Fields
|
Instances
Show NamedParam Source # | |
Defined in PgNamed Methods showsPrec :: Int -> NamedParam -> ShowS # show :: NamedParam -> String # showList :: [NamedParam] -> ShowS # |
Wrapper over name of the argument.
(=?) :: ToField a => Name -> a -> NamedParam infix 1 Source #
Operator to create NamedParam
s.
>>>
"foo" =? (1 :: Int)
NamedParam {namedParamName = "foo", namedParamParam = Plain "1"}
So it can be used in creating the list of the named arguments:
queryNamed [sql| SELECT * FROM users WHERE foo = ?foo AND bar = ?bar AND baz = ?foo" |] [ "foo" =? "fooBar" , "bar" =? "barVar" ]
Errors
data PgNamedError Source #
PostgreSQL
error type for named parameters.
Constructors
PgNamedParam Name | Named parameter is not specified. |
PgNoNames Query | Query has no names inside but was called with named functions. |
PgEmptyName Query | Query contains an empty name. |
Instances
Eq PgNamedError Source # | |
Defined in PgNamed | |
Show PgNamedError Source # | |
Defined in PgNamed Methods showsPrec :: Int -> PgNamedError -> ShowS # show :: PgNamedError -> String # showList :: [PgNamedError] -> ShowS # |
type WithNamedError = MonadError PgNamedError Source #
Type alias for monads that can throw errors of the PgNamedError
type.
Functions to deal with named parameters
extractNames :: Query -> Either PgNamedError (Query, NonEmpty Name) Source #
This function takes query with named parameters specified like this:
SELECT name, user FROM users WHERE id = ?id
and returns either the error or the query with all names replaced by
question marks ?
with the list of the names in the order of their appearance.
For example:
>>>
extractNames "SELECT * FROM users WHERE foo = ?foo AND bar = ?bar AND baz = ?foo"
Right ("SELECT * FROM users WHERE foo = ? AND bar = ? AND baz = ?","foo" :| ["bar","foo"])
Arguments
:: WithNamedError m | |
=> NonEmpty Name | List of the names used in query |
-> [NamedParam] | List of the named parameters |
-> m (NonEmpty Action) |
Returns the list of values to use in query by given list of Name
s.
Throws PgNamedError
if any named parameter is not specified.
Database querying functions with named parameters
Arguments
:: (MonadIO m, WithNamedError m, FromRow res) | |
=> Connection | Database connection |
-> Query | Query with named parameters inside |
-> [NamedParam] | The list of named parameters to be used in the query |
-> m [res] | Resulting rows |
Queries the database with a given query and named parameters and expects a list of rows in return.
queryNamed dbConnection [sql|
SELECT id FROM table
WHERE foo = ?foo
|] [ "foo" =?
"bar" ]
Arguments
:: (MonadIO m, WithNamedError m) | |
=> Connection | Database connection |
-> Query | Query with named parameters inside |
-> [NamedParam] | The list of named parameters to be used in the query |
-> m Int64 | Number of the rows affected by the given query |
Modifies the database with a given query and named parameters and expects a number of the rows affected.
executeNamed dbConnection [sql| UPDATE table SET foo =bar
WHERE id = ?id |] [ "id"=?
someId ]