postgresql-simple-named-0.0.5.0: Implementation of named parameters for `postgresql-simple` library
Safe HaskellSafe-Inferred
LanguageHaskell2010

PgNamed

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 dbConnection [sql|
    SELECT *
    FROM users
    WHERE foo = ?foo
      AND bar = ?bar
      AND baz = ?foo
|] [ "foo" =? "fooBar"
   , "bar" =? "barVar"
   ]
Synopsis

Named data types and smart constructors

data NamedParam Source #

Data type to represent each named parameter.

Constructors

NamedParam 

Instances

Instances details
Show NamedParam Source # 
Instance details

Defined in PgNamed

newtype Name Source #

Wrapper over name of the argument.

Constructors

Name 

Fields

Instances

Instances details
IsString Name Source # 
Instance details

Defined in PgNamed

Methods

fromString :: String -> Name #

Show Name Source # 
Instance details

Defined in PgNamed

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

Eq Name Source # 
Instance details

Defined in PgNamed

Methods

(==) :: Name -> Name -> Bool #

(/=) :: Name -> Name -> Bool #

Ord Name Source # 
Instance details

Defined in PgNamed

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

(>=) :: Name -> Name -> Bool #

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

(=?) :: ToField a => Name -> a -> NamedParam infix 1 Source #

Operator to create NamedParams.

>>> "foo" =? (1 :: Int)
NamedParam {namedParamName = "foo", namedParamParam = Plain "1"}

So it can be used in creating the list of the named arguments:

queryNamed dbConnection [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

Instances details
Show PgNamedError Source # 
Instance details

Defined in PgNamed

Eq PgNamedError Source # 
Instance details

Defined in PgNamed

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"])
>>> extractNames "SELECT foo FROM my_table WHERE (foo->'bar' ??| ?selectedTags);"
Right ("SELECT foo FROM my_table WHERE (foo->'bar' ?| ?);","selectedTags" :| [])

When the operator is not escaped, it's treated as a named parameter >>> extractNames "SELECT foo FROM my_table WHERE (foo->bar ?| ?selectedTags);" Left PostgreSQL named parameter error: Query contains an empty name: SELECT foo FROM my_table WHERE (foo->bar ?| ?selectedTags);

namesToRow Source #

Arguments

:: forall m. 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 Names. Throws PgNamedError if any named parameter is not specified.

Database querying functions with named parameters

queryNamed Source #

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" ]

queryWithNamed Source #

Arguments

:: (MonadIO m, WithNamedError m) 
=> RowParser res

Custom defined row parser

-> 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 row parser, Query, and named parameters and expects a list of rows in return.

Sometimes there are multiple ways to parse tuples returned by PostgreSQL into the same data type. However, it's not possible to implement multiple instances of the FromRow typeclass (or any other typeclass).

Consider the following data type:

data Person = Person
    { personName :: !Text
    , personAge  :: !(Maybe Int)
    }

We might want to parse values of the Person data type in two ways:

  1. Default to parsing all fields.
  2. Parse only name and age to Nothing.

If you want to have multiple instances, you need to create newtype for each case. However, in some cases it might not be convenient to deal with newtypes around large data types. So you can implement custom RowParser and use it with queryWithNamed.

queryWithNamed rowParser dbConnection [sql|
    SELECT id
    FROM table
    WHERE foo = ?foo
|] [ "foo" =? "bar" ]

executeNamed Source #

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 ]

executeNamed_ Source #

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 () 

Same as executeNamed but discard the number of rows affected by the given query. This function is useful when you're not interested in this number.

Internal utils

withNamedArgs :: WithNamedError m => Query -> [NamedParam] -> m (Query, NonEmpty Action) Source #

Helper to use named parameters. Use it to implement named wrappers around functions from postgresql-simple library. If you think that the function is useful, consider opening feature request to the postgresql-simple-named library: