[#2] Add query tests for named parameters (#7)

* [#2] Add query tests for named parameters

Resolves #2

* Don't specify postgresql version

* Change user from root to postgres

* Fix DB name

* Update test/Spec.hs

Co-Authored-By: Veronika Romashkina <[email protected]>

Author: Dmitrii Kovanikov

.travis.yml

@@ -12,6 +12,10 @@ cache:
   - "$HOME/.stack"
   - "$TRAVIS_BUILD_DIR/.stack-work"
 
+# add PostgreSQL with version 10
+services:
+  - postgresql
+
 matrix:
   include:
   - ghc: 8.6.5
@@ -35,6 +39,9 @@ install:
       stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks --ghc-options=-Werror
     fi
 
+before_script:
+  - psql -c "CREATE DATABASE pg_named;" -U postgres
+
 script:
   - |
     if [ -z "$STACK_YAML" ]; then

README.md

@@ -7,3 +7,15 @@
 [![Build status](https://img.shields.io/travis/Holmusk/postgresql-simple-named.svg?logo=travis)](https://travis-ci.org/Holmusk/postgresql-simple-named)
 
 Implementation of named parameters for `postgresql-simple` library
+
+## How to build
+
+Build the library with either `cabal new-build` or `stack build`.
+
+## How to test locally
+
+* Run DB in a Docker in a separate terminal window using command:
+  ```
+  docker run -p 5432\:5432 -e POSTGRES_USER=postgres -e POSTGRES_DB=pg_named postgres\:10.5-alpine
+  ```
+* Run tests using `cabal new-test` or `stack test`

postgresql-simple-named.cabal

@@ -78,7 +78,12 @@ test-suite postgresql-simple-named-test
   hs-source-dirs:      test
   main-is:             Spec.hs
 
-  build-depends:       postgresql-simple-named
+  build-depends:       bytestring
+                     , hspec >= 2.6 && < 2.8
+                     , postgresql-simple-named
+                     , postgresql-simple
+                     , resource-pool
+                     , transformers
 
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
 

test/Spec.hs

@@ -1,4 +1,63 @@
+{-# LANGUAGE DeriveAnyClass     #-}
+{-# LANGUAGE DerivingStrategies #-}
+
 module Main (main) where
 
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
+import Data.Bifunctor (second)
+import Data.ByteString (ByteString)
+import GHC.Generics (Generic)
+import System.IO (hSetEncoding, stderr, stdout, utf8)
+import Test.Hspec (Spec, describe, hspec, it, shouldReturn)
+
+import PgNamed (PgNamedError (..), queryNamed, (=?))
+
+import qualified Data.Pool as Pool
+import qualified Database.PostgreSQL.Simple as Sql
+
+
+connectionSettings :: ByteString
+connectionSettings = "host=localhost port=5432 user=postgres dbname=pg_named"
+
 main :: IO ()
-main = putStrLn ("Test suite not yet implemented" :: String)
+main = do
+    hSetEncoding stdout utf8
+    hSetEncoding stderr utf8
+    dbPool <- Pool.createPool (Sql.connectPostgreSQL connectionSettings) Sql.close 10 5 10
+    hspec $ unitTests dbPool
+
+unitTests :: Pool.Pool Sql.Connection -> Spec
+unitTests dbPool = describe "Testing: postgresql-simple-named" $ do
+    it "returns error when named parameter is not specified" $
+        missingNamedParam `shouldReturn` Left (PgNamedParam "bar")
+    it "no named parameters in a query" $
+        noNamedParams `shouldReturn` Left (PgNoNames "SELECT 42")
+    it "empty name in a query with named parameters" $
+        emptyName `shouldReturn` Left (PgEmptyName "SELECT ?foo, ?")
+    it "named parameters are parsed and passed correctly" $
+        queryTestValue `shouldReturn` Right (TestValue 42 42 "baz")
+  where
+    missingNamedParam :: IO (Either PgNamedError TestValue)
+    missingNamedParam = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?bar" ["foo" =? True]
+
+    noNamedParams :: IO (Either PgNamedError TestValue)
+    noNamedParams = runNamedQuery $ queryNamed dbPool "SELECT 42" []
+
+    emptyName :: IO (Either PgNamedError TestValue)
+    emptyName = runNamedQuery $ queryNamed dbPool "SELECT ?foo, ?" ["foo" =? True]
+
+    queryTestValue :: IO (Either PgNamedError TestValue)
+    queryTestValue = runNamedQuery $ queryNamed dbPool "SELECT ?intVal, ?intVal, ?txtVal"
+        [ "intVal" =? (42 :: Int)
+        , "txtVal" =? ("baz" :: ByteString)
+        ]
+
+runNamedQuery :: ExceptT PgNamedError IO [TestValue] -> IO (Either PgNamedError TestValue)
+runNamedQuery = fmap (second head) . runExceptT
+
+data TestValue = TestValue
+    { intVal1 :: !Int
+    , intVal2 :: !Int
+    , txtVal  :: !ByteString
+    } deriving stock (Show, Eq, Generic)
+      deriving anyclass (Sql.FromRow, Sql.ToRow)