hasql 0.19.3.2 → 0.19.3.3

raw patch · 7 files changed

+73/−11 lines, 7 files

Files

• hasql.cabal +2/−1
• library/Hasql/Decoders/Results.hs +1/−0
• library/Hasql/Private/IO.hs +7/−2
• library/Hasql/Private/Query.hs +4/−4
• library/Hasql/Private/Session.hs +4/−3
• tasty/Main.hs +27/−1
• tasty/Main/Connection.hs +28/−0

@@ -1,7 +1,7 @@ name:   hasql version:-  0.19.3.2+  0.19.3.3 category:   Hasql, Database, PostgreSQL synopsis:@@ -112,6 +112,7 @@     Main.hs   other-modules:     Main.DSL+    Main.Connection     Main.Queries     Main.Prelude   default-extensions:

@@ -29,6 +29,7 @@   -- Usually indicates problems with the connection.   ClientError !(Maybe ByteString) |   ResultError !Result.Error+  deriving (Show)  {-# INLINE run #-} run :: Results a -> (Bool, LibPQ.Connection) -> IO (Either Error a)

@@ -59,9 +59,14 @@  {-# INLINE getResults #-} getResults :: LibPQ.Connection -> Bool -> ResultsDecoders.Results a -> IO (Either ResultsDecoders.Error a)-getResults connection integerDatetimes des =+getResults connection integerDatetimes decoder =   {-# SCC "getResults" #-} -  ResultsDecoders.run (des <* ResultsDecoders.dropRemainders) (integerDatetimes, connection)+  (<*) <$> get <*> dropRemainders+  where+    get =+      ResultsDecoders.run decoder (integerDatetimes, connection)+    dropRemainders =+      ResultsDecoders.run ResultsDecoders.dropRemainders (integerDatetimes, connection)  {-# INLINE getPreparedStatementKey #-} getPreparedStatementKey ::

@@ -54,8 +54,8 @@ statement template encoder decoder preparable =   Query $ Kleisli $ \params ->      ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> -      EitherT $ withMVar pqConnectionRef $ \pqConnection ->-        runEitherT $ do-          EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template encoder preparable params-          EitherT $ IO.getResults pqConnection integerDatetimes decoder+      EitherT $ withMVar pqConnectionRef $ \pqConnection -> do+        r1 <- IO.sendParametricQuery pqConnection integerDatetimes registry template encoder preparable params+        r2 <- IO.getResults pqConnection integerDatetimes decoder+        return $ r1 *> r2 

@@ -31,9 +31,10 @@ sql :: ByteString -> Session () sql sql =   Session $ ReaderT $ \(Connection.Connection pqConnectionRef integerDatetimes registry) ->-    EitherT $ fmap (mapLeft unsafeCoerce) $ withMVar pqConnectionRef $ \pqConnection -> runEitherT $ do-      EitherT $ IO.sendNonparametricQuery pqConnection sql-      EitherT $ IO.getResults pqConnection integerDatetimes decoder+    EitherT $ fmap (mapLeft unsafeCoerce) $ withMVar pqConnectionRef $ \pqConnection -> do+      r1 <- IO.sendNonparametricQuery pqConnection sql+      r2 <- IO.getResults pqConnection integerDatetimes decoder+      return $ r1 *> r2   where     decoder =       Decoders.Results.single $

@@ -9,6 +9,7 @@ import qualified Test.QuickCheck as QuickCheck import qualified Main.Queries as Queries import qualified Main.DSL as DSL+import qualified Main.Connection as Connection import qualified Hasql.Query as Query import qualified Hasql.Encoders as Encoders import qualified Hasql.Decoders as Decoders@@ -21,6 +22,31 @@   localOption (NumThreads 1) $   testGroup "All tests"   [+    testCase "\"in progress after error\" bugfix" $+    let+      sumQuery :: Query.Query (Int64, Int64) Int64+      sumQuery =+        Query.statement sql encoder decoder True+        where+          sql =+            "select ($1 + $2)"+          encoder =+            contramap fst (Encoders.value Encoders.int8) <>+            contramap snd (Encoders.value Encoders.int8)+          decoder =+            Decoders.singleRow (Decoders.value Decoders.int8)+      sumSession :: Session.Session Int64+      sumSession =+        Session.sql "begin" *> Session.query (1, 1) sumQuery <* Session.sql "end"+      errorSession :: Session.Session ()+      errorSession =+        Session.sql "asldfjsldk"+      io =+        Connection.with $ \c -> do+          Session.run errorSession c+          Session.run sumSession c+      in io >>= \x -> assertBool (show x) (either (const False) isRight x)+    ,     testCase "\"another command is already in progress\" bugfix" $     let       sumQuery :: Query.Query (Int64, Int64) Int64@@ -41,7 +67,7 @@           s <- Session.query (1,1) sumQuery           Session.sql "end;"           return s-      in DSL.session session >>= \x -> assertBool (show x) (isRight x)+      in DSL.session session >>= \x -> assertEqual (show x) (Right 2) x     ,     testCase "Executing the same query twice" $     pure ()

@@ -0,0 +1,28 @@+module Main.Connection+where++import Main.Prelude+import qualified Hasql.Connection as HC+import qualified Hasql.Query as HQ+import qualified Hasql.Session+++with :: (HC.Connection -> IO a) -> IO (Either HC.ConnectionError a)+with handler =+  runEitherT $ acquire >>= \connection -> use connection <* release connection+  where+    acquire =+      EitherT $ HC.acquire settings+      where+        settings =+          HC.settings host port user password database+          where+            host = "localhost"+            port = 5432+            user = "postgres"+            password = ""+            database = "postgres"+    use connection =+      lift $ handler connection+    release connection =+      lift $ HC.release connection