hasql 0.19.18 → 0.19.18.1
raw patch · 8 files changed
+253/−178 lines, 8 filesdep +bugdep −deepseqdep −scientificdep −timedep ~basedep ~base-preludedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: bug
Dependencies removed: deepseq, scientific, time, uuid
Dependency ranges changed: base, base-prelude, bytestring, contravariant, contravariant-extras, criterion, data-default-class, dlist, either, hashable, profunctors, rerebase, text, transformers, vector
API changes (from Hackage documentation)
Files
- benchmark/Main.hs +0/−53
- benchmark/Main/Prelude.hs +0/−65
- benchmark/Main/Queries.hs +0/−29
- benchmarks/Main.hs +101/−0
- hasql.cabal +28/−30
- library/Hasql/Encoders.hs +25/−0
- library/Hasql/Private/Prelude.hs +1/−1
- profiling/Main.hs +98/−0
− benchmark/Main.hs
@@ -1,53 +0,0 @@-module Main where--import Main.Prelude-import Criterion.Main-import qualified Hasql.Connection as HC-import qualified Hasql.Query as HQ-import qualified Hasql.Encoders as HE-import qualified Hasql.Decoders as HD-import qualified Hasql.Session-import qualified Main.Queries as Q---main =- HC.acquire settings >>= either (fail . show) use- where- settings =- HC.settings host port user password database- where- host = "localhost"- port = 5432- user = "postgres"- password = ""- database = "postgres"- use connection =- defaultMain- [- bgroup "decoding"- [- bgroup "1 column"- [- bench "1 row" $ nfIO $! query () $! Q.select1 1- ,- bench "100 rows" $ nfIO $! query () $! Q.select1 100- ,- bench "10000 rows" $ nfIO $! query () $! Q.select1 10000- ]- ,- bgroup "4 columns"- [- bench "1 row" $ nfIO $! query () $! Q.select4 1- ,- bench "100 rows" $ nfIO $! query () $! Q.select4 100- ,- bench "10000 rows" $ nfIO $! query () $! Q.select4 10000- ]- ]- ]- where- query :: a -> HQ.Query a b -> IO b- query params query =- {-# SCC "query" #-} - (=<<) (either (fail . show) pure) $- flip Hasql.Session.run connection $ Hasql.Session.query params query
− benchmark/Main/Prelude.hs
@@ -1,65 +0,0 @@-module Main.Prelude-(- module Exports,-)-where----- 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---- 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)---- vector---------------------------import Data.Vector as Exports (Vector)---- dlist---------------------------import Data.DList as Exports (DList)---- deepseq---------------------------import Control.DeepSeq as Exports (NFData(..), force, deepseq, ($!!))
− benchmark/Main/Queries.hs
@@ -1,29 +0,0 @@-module Main.Queries where--import Main.Prelude-import qualified Hasql.Query as HQ-import qualified Hasql.Encoders as HE-import qualified Hasql.Decoders as HD---select1 :: Int -> HQ.Query () (Vector Int64)-select1 amount =- {-# SCC "select1" #-} - HQ.statement sql mempty decoder True- where- !sql =- "values " <>- mconcat (intersperse ", " (replicate amount "(1)"))- decoder =- HD.rowsVector (HD.value HD.int8)--select4 :: Int -> HQ.Query () (Vector (Int64, Int64, Int64, Int64))-select4 amount =- {-# SCC "select4" #-} - HQ.statement sql mempty decoder True- where- !sql =- "values " <>- mconcat (intersperse ", " (replicate amount "(1, 2, 3, 4)"))- decoder =- HD.rowsVector ((,,,) <$> HD.value HD.int8 <*> HD.value HD.int8 <*> HD.value HD.int8 <*> HD.value HD.int8)
+ benchmarks/Main.hs view
@@ -0,0 +1,101 @@+module Main where++import Prelude+import Bug+import Criterion+import Criterion.Main+import qualified Hasql.Connection as A+import qualified Hasql.Session as B+import qualified Hasql.Query as C+import qualified Hasql.Decoders as D+import qualified Hasql.Encoders as E+import qualified Data.Vector as F+++main =+ do+ Right connection <- acquireConnection+ useConnection connection+ where+ acquireConnection =+ A.acquire ""+ useConnection connection =+ defaultMain+ [+ sessionBench "largeResultInVector" sessionWithSingleLargeResultInVector+ ,+ sessionBench "largeResultInList" sessionWithSingleLargeResultInList+ ,+ sessionBench "manySmallResults" sessionWithManySmallResults+ ]+ where+ sessionBench :: NFData a => String -> B.Session a -> Benchmark+ sessionBench name session =+ bench name (nfIO (fmap (either ($bug "") id) (B.run session connection)))+++-- * Sessions+-------------------------++sessionWithManySmallParameters :: Vector (Int64, Int64) -> B.Session ()+sessionWithManySmallParameters =+ $(todo "sessionWithManySmallParameters")++sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64))+sessionWithSingleLargeResultInVector =+ B.query () queryWithManyRowsInVector++sessionWithSingleLargeResultInList :: B.Session (List (Int64, Int64))+sessionWithSingleLargeResultInList =+ B.query () queryWithManyRowsInList++sessionWithManySmallResults :: B.Session (Vector (Int64, Int64))+sessionWithManySmallResults =+ F.replicateM 1000 (B.query () queryWithSingleRow)+++-- * Statements+-------------------------++queryWithManyParameters :: C.Query (Vector (Int64, Int64)) ()+queryWithManyParameters =+ $(todo "statementWithManyParameters")++queryWithSingleRow :: C.Query () (Int64, Int64)+queryWithSingleRow =+ C.statement template encoder decoder True+ where+ template =+ "SELECT 1, 2"+ encoder =+ conquer+ decoder =+ D.singleRow row+ where+ row =+ tuple <$> D.value D.int8 <*> D.value D.int8+ where+ tuple !a !b =+ (a, b)++queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result+queryWithManyRows decoder =+ C.statement template encoder (decoder rowDecoder) True+ where+ template =+ "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"+ encoder =+ conquer+ rowDecoder =+ tuple <$> D.value D.int8 <*> D.value D.int8+ where+ tuple !a !b =+ (a, b)++queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64))+queryWithManyRowsInVector =+ queryWithManyRows D.rowsVector++queryWithManyRowsInList :: C.Query () (List (Int64, Int64))+queryWithManyRowsInList =+ queryWithManyRows D.rowsList
hasql.cabal view
@@ -1,7 +1,7 @@ name: hasql version:- 0.19.18+ 0.19.18.1 category: Hasql, Database, PostgreSQL synopsis:@@ -158,25 +158,19 @@ rebase -benchmark benchmark+benchmark benchmarks type: exitcode-stdio-1.0 hs-source-dirs:- benchmark+ benchmarks main-is: Main.hs- other-modules:- Main.Queries- Main.Prelude ghc-options: -O2 -threaded "-with-rtsopts=-N"- ghc-prof-options:- -O2- -threaded- -fprof-auto- "-with-rtsopts=-N -p -s -h -i0.1"+ -rtsopts+ -funbox-strict-fields default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples default-language:@@ -184,24 +178,28 @@ build-depends: hasql, -- benchmarking:- criterion == 1.1.*,- -- data:- uuid,- time,- scientific,- bytestring,- text,- vector,- hashable,- dlist,+ criterion >= 1.1 && < 2, -- general:- deepseq >= 1 && < 2,- data-default-class,- profunctors,- contravariant,- contravariant-extras,- either,- transformers,- base-prelude,- base+ bug == 1.*,+ rerebase < 2 ++test-suite profiling+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ profiling+ main-is:+ Main.hs+ ghc-options:+ -O2+ -threaded+ -rtsopts+ default-extensions:+ Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language:+ Haskell2010+ build-depends:+ hasql,+ bug == 1.*,+ rerebase == 1.*
library/Hasql/Encoders.hs view
@@ -39,6 +39,8 @@ arrayValue, arrayNullableValue, arrayDimension,+ -- ** Insert Many+ -- $insertMany ) where @@ -533,3 +535,26 @@ arrayDimension foldl (Array imp) = Array (Array.dimension foldl imp) +-- $insertMany+-- It is not currently possible to pass in an array of encodable values+-- to use in an 'insert many' query using Hasql. Instead, PostgreSQL's+-- (9.4 or later) `unnest` function can be used to in an analogous way+-- to haskell's `zip` function by passing in multiple arrays of values+-- to be zipped into the rows we want to insert:+--+-- @+-- insertMultipleLocations :: Query (Vector (UUID, Double, Double)) ()+-- insertMultipleLocations =+-- statement sql encoder decoder True+-- where+-- sql =+-- "insert into location (id, x, y) select * from unnest ($1, $2, $3)"+-- encoder =+-- contramap Vector.unzip3 $+-- contrazip3 (vector Encoders.uuid) (vector Encoders.float8) (vector Encoders.float8)+-- where+-- vector value =+-- Encoders.value (Encoders.array (Encoders.arrayDimension foldl' (Encoders.arrayValue value)))+-- decoder =+-- Decoders.unit+-- @
library/Hasql/Private/Prelude.hs view
@@ -16,7 +16,7 @@ -- base-prelude --------------------------import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error, (<>), First(..), Last(..), new)+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, fromLeft, fromRight, error, (<>), First(..), Last(..), new) -- transformers -------------------------
+ profiling/Main.hs view
@@ -0,0 +1,98 @@+module Main where++import Prelude+import Bug+import qualified Hasql.Connection as A+import qualified Hasql.Session as B+import qualified Hasql.Query as C+import qualified Hasql.Decoders as D+import qualified Hasql.Encoders as E+import qualified Data.Vector as F+++main =+ do+ Right connection <- acquireConnection+ traceEventIO "START Session"+ Right result <- B.run sessionWithManySmallResults connection+ traceEventIO "STOP Session"+ return ()+ where+ acquireConnection =+ A.acquire settings+ where+ settings =+ A.settings host port user password database+ where+ host = "localhost"+ port = 5432+ user = "postgres"+ password = ""+ database = "postgres"+++-- * Sessions+-------------------------++sessionWithManySmallParameters :: Vector (Int64, Int64) -> B.Session ()+sessionWithManySmallParameters =+ $(todo "sessionWithManySmallParameters")++sessionWithSingleLargeResultInVector :: B.Session (Vector (Int64, Int64))+sessionWithSingleLargeResultInVector =+ B.query () queryWithManyRowsInVector++sessionWithSingleLargeResultInList :: B.Session (List (Int64, Int64))+sessionWithSingleLargeResultInList =+ B.query () queryWithManyRowsInList++sessionWithManySmallResults :: B.Session (Vector (Int64, Int64))+sessionWithManySmallResults =+ F.replicateM 1000 (B.query () queryWithSingleRow)+++-- * Statements+-------------------------++queryWithManyParameters :: C.Query (Vector (Int64, Int64)) ()+queryWithManyParameters =+ $(todo "statementWithManyParameters")++queryWithSingleRow :: C.Query () (Int64, Int64)+queryWithSingleRow =+ C.statement template encoder decoder True+ where+ template =+ "SELECT 1, 2"+ encoder =+ conquer+ decoder =+ D.singleRow row+ where+ row =+ tuple <$> D.value D.int8 <*> D.value D.int8+ where+ tuple !a !b =+ (a, b)++queryWithManyRows :: (D.Row (Int64, Int64) -> D.Result result) -> C.Query () result+queryWithManyRows decoder =+ C.statement template encoder (decoder rowDecoder) True+ where+ template =+ "SELECT generate_series(0,1000) as a, generate_series(1000,2000) as b"+ encoder =+ conquer+ rowDecoder =+ tuple <$> D.value D.int8 <*> D.value D.int8+ where+ tuple !a !b =+ (a, b)++queryWithManyRowsInVector :: C.Query () (Vector (Int64, Int64))+queryWithManyRowsInVector =+ queryWithManyRows D.rowsVector++queryWithManyRowsInList :: C.Query () (List (Int64, Int64))+queryWithManyRowsInList =+ queryWithManyRows D.rowsList