Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions postgresql-simple-named.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,6 @@ library
build-depends: bytestring ^>= 0.10.8
, mtl ^>= 2.2
, postgresql-simple ^>= 0.6.2
, resource-pool ^>= 0.2.3.2
, text ^>= 1.2

test-suite postgresql-simple-named-test
Expand All @@ -82,7 +81,7 @@ test-suite postgresql-simple-named-test
, hspec >= 2.6 && < 2.8
, postgresql-simple-named
, postgresql-simple
, resource-pool
, resource-pool ^>= 0.2.3.2
, transformers

ghc-options: -threaded -rtsopts -with-rtsopts=-N
Expand Down
18 changes: 8 additions & 10 deletions src/PgNamed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -46,13 +46,11 @@ import Data.Char (isAlphaNum)
import Data.Int (Int64)
import Data.List (lookup)
import Data.List.NonEmpty (NonEmpty (..), toList)
import Data.Pool (Pool)
import Data.Text (Text)
import Data.Text.Encoding (decodeUtf8)
import GHC.Exts (IsString)

import qualified Data.ByteString.Char8 as BS
import qualified Data.Pool as Pool
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.ToField as PG
import qualified Database.PostgreSQL.Simple.Types as PG
Expand Down Expand Up @@ -171,27 +169,27 @@ n =? a = NamedParam n $ PG.toField a
and expects a list of rows in return.

@
queryNamed dbPool [sql|
queryNamed dbConnection [sql|
SELECT id FROM table
WHERE foo = ?foo
|] [ "foo" '=?' "bar" ]
@
-}
queryNamed
:: (MonadIO m, WithError m, PG.FromRow res)
=> Pool PG.Connection -- ^ Database connection pool
=> PG.Connection -- ^ Database connection
-> PG.Query -- ^ Query with named parameters inside
-> [NamedParam] -- ^ The list of named parameters to be used in the query
-> m [res] -- ^ Resulting rows
queryNamed pool qNamed params =
queryNamed conn qNamed params =
withNamedArgs qNamed params >>= \(q, actions) ->
liftIO $ Pool.withResource pool (\conn -> PG.query conn q (toList actions))
liftIO $ PG.query conn q (toList actions)

{- | Modifies the database with a given query and named parameters
and expects a number of the rows affected.

@
executeNamed dbPool [sql|
executeNamed dbConnection [sql|
UPDATE table
SET foo = 'bar'
WHERE id = ?id
Expand All @@ -200,13 +198,13 @@ executeNamed dbPool [sql|
-}
executeNamed
:: (MonadIO m, WithError m)
=> Pool PG.Connection -- ^ Database connection pool
=> PG.Connection -- ^ Database connection
-> PG.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
executeNamed pool qNamed params =
executeNamed conn qNamed params =
withNamedArgs qNamed params >>= \(q, actions) ->
liftIO $ Pool.withResource pool (\conn -> PG.execute conn q (toList actions))
liftIO $ PG.execute conn q (toList actions)

-- | Helper to use named parameters.
withNamedArgs
Expand Down
13 changes: 8 additions & 5 deletions test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ import GHC.Generics (Generic)
import System.IO (hSetEncoding, stderr, stdout, utf8)
import Test.Hspec (Spec, describe, hspec, it, shouldReturn)

import PgNamed (PgNamedError (..), queryNamed, (=?))
import PgNamed (NamedParam, PgNamedError (..), queryNamed, (=?))

import qualified Data.Pool as Pool
import qualified Database.PostgreSQL.Simple as Sql
Expand Down Expand Up @@ -38,20 +38,23 @@ unitTests dbPool = describe "Testing: postgresql-simple-named" $ do
queryTestValue `shouldReturn` Right (TestValue 42 42 "baz")
where
missingNamedParam :: IO (Either PgNamedError TestValue)
missingNamedParam = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?bar" ["foo" =? True]
missingNamedParam = run "SELECT ?foo, ?bar" ["foo" =? True]

noNamedParams :: IO (Either PgNamedError TestValue)
noNamedParams = runNamedQuery $ queryNamed dbPool "SELECT 42" []
noNamedParams = run "SELECT 42" []

emptyName :: IO (Either PgNamedError TestValue)
emptyName = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?" ["foo" =? True]
emptyName = run "SELECT ?foo, ?" ["foo" =? True]

queryTestValue :: IO (Either PgNamedError TestValue)
queryTestValue = runNamedQuery $ queryNamed dbPool "SELECT ?intVal, ?intVal, ?txtVal"
queryTestValue = run "SELECT ?intVal, ?intVal, ?txtVal"
[ "intVal" =? (42 :: Int)
, "txtVal" =? ("baz" :: ByteString)
]

run :: Sql.Query -> [NamedParam] -> IO (Either PgNamedError TestValue)
run q params = runNamedQuery $ Pool.withResource dbPool (\conn -> queryNamed conn q params)

runNamedQuery :: ExceptT PgNamedError IO [TestValue] -> IO (Either PgNamedError TestValue)
runNamedQuery = fmap (second head) . runExceptT

Expand Down