Benchmarks

benchmark/Main.hs

@@ -0,0 +1,49 @@
+module Main where
+
+import Main.Prelude
+import Criterion.Main
+import qualified Hasql as H
+import qualified Hasql.Serialization as HS
+import qualified Hasql.Deserialization as HD
+import qualified Main.Queries as Q
+
+
+main =
+  H.connect settings >>= either (fail . show) use
+  where
+    settings =
+      H.ParametricSettings 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 -> H.Query a b -> IO b
+        query params query =
+          H.query connection query params >>= either (fail . show) pure

benchmark/Main/Prelude.hs

@@ -0,0 +1,73 @@
+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)
+
+-- 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)

benchmark/Main/Queries.hs

@@ -0,0 +1,27 @@
+module Main.Queries where
+
+import Main.Prelude
+import qualified Hasql as H
+import qualified Hasql.Serialization as HS
+import qualified Hasql.Deserialization as HD
+
+
+select1 :: Int -> H.Query () (Vector Int64)
+select1 amount =
+  (sql, mempty, deserializer, True)
+  where
+    sql =
+      "values " <>
+      mconcat (intersperse ", " (replicate amount "(1)"))
+    deserializer =
+      HD.rowsVector (HD.value HD.int8)
+
+select4 :: Int -> H.Query () (Vector (Int64, Int64, Int64, Int64))
+select4 amount =
+  (sql, mempty, deserializer, True)
+  where
+    sql =
+      "values " <>
+      mconcat (intersperse ", " (replicate amount "(1, 2, 3, 4)"))
+    deserializer =
+      HD.rowsVector ((,,,) <$> HD.value HD.int8 <*> HD.value HD.int8 <*> HD.value HD.int8 <*> HD.value HD.int8)

hasql.cabal

@@ -184,3 +184,46 @@ executable demo
     text,
     bytestring,
     base-prelude
+
+
+benchmark benchmark
+  type: 
+    exitcode-stdio-1.0
+  hs-source-dirs:
+    benchmark
+  main-is:
+    Main.hs
+  other-modules:
+    Main.Queries
+  ghc-options:
+    -O2
+    -threaded
+    "-with-rtsopts=-N"
+    -funbox-strict-fields
+  default-extensions:
+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, ImpredicativeTypes, 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,
+    -- benchmarking:
+    criterion == 1.1.*,
+    -- data:
+    uuid,
+    time,
+    scientific,
+    bytestring,
+    text,
+    vector,
+    hashable,
+    dlist,
+    -- general:
+    data-default-class,
+    profunctors,
+    contravariant,
+    contravariant-extras,
+    either,
+    transformers,
+    base-prelude,
+    base
+