hasql 0.19.8 → 0.19.9
raw patch · 9 files changed
+118/−115 lines, 9 filesdep +bytestring-tree-builderdep +rebasedep +semigroupsdep ~basedep ~base-preludedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring-tree-builder, rebase, semigroups
Dependency ranges changed: base, base-prelude, bytestring, contravariant, contravariant-extras, dlist, either, hashable, profunctors, scientific, text, time, transformers, uuid, vector
API changes (from Hackage documentation)
+ Hasql.Encoders: instance Data.Semigroup.Semigroup (Hasql.Encoders.Params a)
Files
- hasql.cabal +6/−17
- library/Hasql/Commands.hs +2/−0
- library/Hasql/Encoders.hs +1/−1
- library/Hasql/Encoders/Params.hs +2/−0
- library/Hasql/Prelude.hs +5/−1
- library/Hasql/Private/IO.hs +21/−18
- library/Hasql/Private/PreparedStatementRegistry.hs +28/−18
- tasty/Main.hs +52/−0
- tasty/Main/Prelude.hs +1/−60
hasql.cabal view
@@ -1,7 +1,7 @@ name: hasql version:- 0.19.8+ 0.19.9 category: Hasql, Database, PostgreSQL synopsis:@@ -76,6 +76,8 @@ -- database: postgresql-binary >= 0.8 && < 0.9, postgresql-libpq == 0.9.*,+ -- builders:+ bytestring-tree-builder >= 0.2.5 && < 0.3, -- data: dlist >= 0.7 && < 0.8, aeson >= 0.7 && < 0.12,@@ -88,6 +90,7 @@ bytestring >= 0.10 && < 0.11, hashable >= 1.2 && < 1.3, -- control:+ semigroups >= 0.18 && < 0.20, data-default-class >= 0.0.1 && < 0.1, profunctors >= 5.1 && < 6, contravariant-extras == 0.3.*,@@ -129,24 +132,10 @@ tasty-hunit == 0.9.*, quickcheck-instances >= 0.3.11 && < 0.4, QuickCheck >= 2.8.1 && < 2.9,- -- data:- uuid,- time,- scientific,- bytestring,- text,- vector,- hashable,- dlist, -- general: data-default-class,- profunctors,- contravariant,- contravariant-extras,- either,- transformers,- base-prelude,- base+ -- base,+ rebase benchmark benchmark
library/Hasql/Commands.hs view
@@ -18,6 +18,8 @@ Commands (DList BB.Builder) deriving (Monoid) +instance Semigroup Commands+ asBytes :: Commands -> ByteString asBytes (Commands list) = BL.toStrict $ BB.toLazyByteString $ foldMap (<> BB.char7 ';') $ list
library/Hasql/Encoders.hs view
@@ -106,7 +106,7 @@ -- newtype Params a = Params (Params.Params a)- deriving (Contravariant, Divisible, Monoid)+ deriving (Contravariant, Divisible, Monoid, Semigroup) -- | -- Encode no parameters.
library/Hasql/Encoders/Params.hs view
@@ -13,6 +13,8 @@ Params (Op (DList (LibPQ.Oid, Bool -> Maybe ByteString)) a) deriving (Contravariant, Divisible, Monoid) +instance Semigroup (Params a)+ run :: Params a -> a -> DList (LibPQ.Oid, Bool -> Maybe ByteString) run (Params (Op op)) params = {-# SCC "run" #-}
library/Hasql/Prelude.hs view
@@ -16,7 +16,7 @@ -- base-prelude --------------------------import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error)+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error, (<>), First(..), Last(..)) -- transformers -------------------------@@ -52,6 +52,10 @@ ------------------------- import Control.Monad.Trans.Either as Exports import Data.Either.Combinators as Exports++-- semigroups+-------------------------+import Data.Semigroup as Exports -- hashable -------------------------
library/Hasql/Private/IO.hs view
@@ -75,25 +75,28 @@ IO (Either ResultsDecoders.Error ByteString) getPreparedStatementKey connection registry template oidList = {-# SCC "getPreparedStatementKey" #-} - do- keyMaybe <- PreparedStatementRegistry.lookup template wordOIDList registry- case keyMaybe of- Just key ->- pure (pure key)- Nothing -> - do- key <- PreparedStatementRegistry.register template wordOIDList registry- sent <- LibPQ.sendPrepare connection key template (mfilter (not . null) (Just oidList))- let resultsDecoder = - if sent- then ResultsDecoders.single ResultDecoders.unit- else ResultsDecoders.clientError- runEitherT $ do- EitherT $ getResults connection undefined resultsDecoder- pure key+ PreparedStatementRegistry.update localKey onNewRemoteKey onOldRemoteKey registry where- wordOIDList =- map (\(LibPQ.Oid x) -> fromIntegral x) oidList+ localKey =+ PreparedStatementRegistry.LocalKey template wordOIDList+ where+ wordOIDList =+ map (\(LibPQ.Oid x) -> fromIntegral x) oidList+ onNewRemoteKey key =+ do+ sent <- LibPQ.sendPrepare connection key template (mfilter (not . null) (Just oidList))+ let resultsDecoder = + if sent+ then ResultsDecoders.single ResultDecoders.unit+ else ResultsDecoders.clientError+ fmap resultsMapping $ getResults connection undefined resultsDecoder+ where+ resultsMapping =+ \case+ Left x -> (False, Left x)+ Right _ -> (True, Right key)+ onOldRemoteKey key =+ pure (pure key) {-# INLINE checkedSend #-} checkedSend :: LibPQ.Connection -> IO Bool -> IO (Either ResultsDecoders.Error ())
library/Hasql/Private/PreparedStatementRegistry.hs view
@@ -2,37 +2,47 @@ ( PreparedStatementRegistry, new,- lookup,- register,+ update,+ LocalKey(..), ) where import Hasql.Prelude hiding (lookup)-import qualified Data.HashTable.IO as Hashtables+import qualified Data.HashTable.IO as A+import qualified ByteString.TreeBuilder as B data PreparedStatementRegistry =- PreparedStatementRegistry !(Hashtables.BasicHashTable LocalKey ByteString) !(IORef Word)+ PreparedStatementRegistry !(A.BasicHashTable LocalKey ByteString) !(IORef Word) {-# INLINABLE new #-} new :: IO PreparedStatementRegistry new =- PreparedStatementRegistry <$> Hashtables.new <*> newIORef 0+ PreparedStatementRegistry <$> A.new <*> newIORef 0 -{-# INLINABLE lookup #-}-lookup :: ByteString -> [Word32] -> PreparedStatementRegistry -> IO (Maybe ByteString)-lookup template oids (PreparedStatementRegistry table counter) =- Hashtables.lookup table (LocalKey template oids)+{-# INLINABLE update #-}+update :: LocalKey -> (ByteString -> IO (Bool, a)) -> (ByteString -> IO a) -> PreparedStatementRegistry -> IO a+update localKey onNewRemoteKey onOldRemoteKey (PreparedStatementRegistry table counter) =+ lookup >>= maybe new old+ where+ lookup =+ A.lookup table localKey+ new =+ readIORef counter >>= onN+ where+ onN n =+ do+ (save, result) <- onNewRemoteKey remoteKey+ when save $ do+ A.insert table localKey remoteKey+ writeIORef counter (succ n)+ return result+ where+ remoteKey =+ B.toByteString . B.asciiIntegral $ n+ old =+ onOldRemoteKey -{-# INLINABLE register #-}-register :: ByteString -> [Word32] -> PreparedStatementRegistry -> IO ByteString-register template oids (PreparedStatementRegistry table counter) =- do- n <- readIORef counter- writeIORef counter (succ n)- let remoteKey = fromString (show n)- Hashtables.insert table (LocalKey template oids) remoteKey- return remoteKey -- | -- Local statement key.
tasty/Main.hs view
@@ -22,6 +22,58 @@ localOption (NumThreads 1) $ testGroup "All tests" [+ testCase "Failing prepared statements" $+ let+ io =+ Connection.with (Session.run session) >>=+ (assertBool <$> show <*> resultTest)+ where+ resultTest =+ \case+ Right (Left (Session.ResultError (Session.ServerError "26000" _ _ _))) -> False+ _ -> True+ session =+ catchError session (const (pure ())) *> session+ where+ session =+ Session.query () query+ where+ query =+ Query.statement sql encoder decoder True+ where+ sql =+ "absurd"+ encoder =+ Encoders.unit+ decoder =+ Decoders.unit+ in io+ ,+ testCase "Prepared statements after error" $+ let+ io =+ Connection.with (Session.run session) >>=+ \x -> assertBool (show x) (either (const False) isRight x)+ where+ session =+ try *> fail *> try+ where+ try =+ Session.query 1 query+ where+ query =+ Query.statement sql encoder decoder True+ where+ sql =+ "select $1 :: int8"+ encoder =+ Encoders.value Encoders.int8+ decoder =+ Decoders.singleRow $ Decoders.value Decoders.int8+ fail =+ catchError (Session.sql "absurd") (const (pure ()))+ in io+ , testCase "\"in progress after error\" bugfix" $ let sumQuery :: Query.Query (Int64, Int64) Int64
tasty/Main/Prelude.hs view
@@ -7,67 +7,8 @@ -- base-prelude --------------------------import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error)---- transformers---------------------------import Control.Monad.IO.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)-import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)-import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)-import Data.Functor.Identity as Exports+import Rebase.Prelude as Exports -- data-default-class ------------------------- import Data.Default.Class as Exports---- profunctors---------------------------import Data.Profunctor.Unsafe as Exports---- contravariant---------------------------import Data.Functor.Contravariant as Exports-import Data.Functor.Contravariant.Divisible as Exports---- contravariant-extras---------------------------import Contravariant.Extras as Exports---- either---------------------------import Control.Monad.Trans.Either as Exports-import Data.Either.Combinators as Exports---- hashable---------------------------import Data.Hashable as Exports (Hashable(..))---- text---------------------------import Data.Text as Exports (Text)---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- scientific---------------------------import Data.Scientific as Exports (Scientific)---- uuid---------------------------import Data.UUID as Exports (UUID)---- time---------------------------import Data.Time as Exports---- vector---------------------------import Data.Vector as Exports (Vector)---- dlist---------------------------import Data.DList as Exports (DList)