{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{- |
[Database semantic conventions have been declared stable.](https://opentelemetry.io/docs/specs/semconv/non-normative/db-migration/) Opt-in by setting the environment variable OTEL_SEMCONV_STABILITY_OPT_IN to
- "database" - to use the stable conventions
- "database/dup" - to emit both the old and the stable conventions
Otherwise, the old conventions will be used. The stable conventions will replace the old conventions in the next major release of this library.
-}
module OpenTelemetry.Instrumentation.PostgresqlSimple (
  staticConnectionAttributes,

  -- * Queries that return results
  query,
  query_,

  -- ** Queries taking parser as argument
  queryWith,
  queryWith_,

  -- * Queries that stream results
  fold,
  foldWithOptions,
  fold_,
  foldWithOptions_,
  forEach,
  forEach_,
  returning,

  -- ** Queries that stream results taking a parser as an argument
  foldWith,
  foldWithOptionsAndParser,
  foldWith_,
  foldWithOptionsAndParser_,
  forEachWith,
  forEachWith_,
  returningWith,

  -- * Statements that do not return results
  execute,
  execute_,
  executeMany,

  -- * Reexported functions
  module X,

  -- * Utility functions
  pgsSpan,

  -- * Span naming helpers (exported for testing)
  extractOperationName,
) where

import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import qualified Data.ByteString.Char8 as C
import qualified Data.HashMap.Strict as H
import Data.IP
import Data.Int (Int64)
import Data.List
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Simple as X hiding (
  execute,
  executeMany,
  execute_,
  fold,
  foldWith,
  foldWithOptions,
  foldWithOptionsAndParser,
  foldWithOptionsAndParser_,
  foldWithOptions_,
  foldWith_,
  fold_,
  forEach,
  forEachWith,
  forEachWith_,
  forEach_,
  query,
  queryWith,
  queryWith_,
  query_,
  returning,
  returningWith,
 )
import qualified Database.PostgreSQL.Simple as Simple
import qualified Database.PostgreSQL.Simple.FromRow as Simple
import Database.PostgreSQL.Simple.Internal (
  Connection (Connection, connectionHandle),
  withConnection,
 )
import GHC.Stack
import OpenTelemetry.Attributes.Key (unkey)
import OpenTelemetry.Resource ((.=), (.=?))
import qualified OpenTelemetry.SemanticConventions as SC
import OpenTelemetry.SemanticsConfig
import OpenTelemetry.Trace.Core as TC
import Text.Read (readMaybe)
import UnliftIO


-- | Get attributes that can be attached to a span denoting some database action
staticConnectionAttributes :: (HasCallStack, MonadIO m) => Connection -> m (H.HashMap T.Text Attribute)
staticConnectionAttributes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Connection -> m (HashMap Text Attribute)
staticConnectionAttributes Connection {MVar Connection
connectionHandle :: Connection -> MVar Connection
connectionHandle :: MVar Connection
connectionHandle} = IO (HashMap Text Attribute) -> m (HashMap Text Attribute)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap Text Attribute) -> m (HashMap Text Attribute))
-> IO (HashMap Text Attribute) -> m (HashMap Text Attribute)
forall a b. (a -> b) -> a -> b
$ do
  (mDb, mUser, mHost, mPort) <- MVar Connection
-> (Connection
    -> IO
         (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
withMVar MVar Connection
connectionHandle ((Connection
  -> IO
       (Maybe ByteString, Maybe ByteString, Maybe ByteString,
        Maybe ByteString))
 -> IO
      (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> (Connection
    -> IO
         (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Connection
pqConn -> do
    (,,,)
      (Maybe ByteString
 -> Maybe ByteString
 -> Maybe ByteString
 -> Maybe ByteString
 -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
     Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> Maybe ByteString
      -> Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
LibPQ.db Connection
pqConn
      IO
  (Maybe ByteString
   -> Maybe ByteString
   -> Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.user Connection
pqConn
      IO
  (Maybe ByteString
   -> Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString
      -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
          Maybe ByteString))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.host Connection
pqConn
      IO
  (Maybe ByteString
   -> (Maybe ByteString, Maybe ByteString, Maybe ByteString,
       Maybe ByteString))
-> IO (Maybe ByteString)
-> IO
     (Maybe ByteString, Maybe ByteString, Maybe ByteString,
      Maybe ByteString)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Connection -> IO (Maybe ByteString)
LibPQ.port Connection
pqConn

  let stableMaybeAttributes =
        [ AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_system_name Text -> Attribute -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text
"postgresql" :: T.Text)
        , AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_namespace Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mDb)
        , AttributeKey Int64 -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Int64
SC.server_port
            Text -> Maybe Int -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (Maybe ByteString
mPort Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, ByteString) -> Maybe Int)
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
C.readInt)
        , case (String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP)
-> (ByteString -> String) -> ByteString -> Maybe IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack) (ByteString -> Maybe IP) -> Maybe ByteString -> Maybe IP
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mHost of
            Maybe IP
Nothing -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.server_address Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mHost)
            Just (IPv4 IPv4
ipv4) -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.server_address Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv4 -> String
forall a. Show a => a -> String
show IPv4
ipv4)
            Just (IPv6 IPv6
ipv6) -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.server_address Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv6 -> String
forall a. Show a => a -> String
show IPv6
ipv6)
        ]
      oldMaybeAttributes =
        [ AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_system Text -> Attribute -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute (Text
"postgresql" :: T.Text)
        , AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_user Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mUser)
        , AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_name Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mDb)
        , AttributeKey Int64 -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Int64
SC.net_peer_port
            Text -> Maybe Int -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (Maybe ByteString
mPort Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, ByteString) -> Maybe Int)
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
C.readInt)
        , case (String -> Maybe IP
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe IP)
-> (ByteString -> String) -> ByteString -> Maybe IP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
C.unpack) (ByteString -> Maybe IP) -> Maybe ByteString -> Maybe IP
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ByteString
mHost of
            Maybe IP
Nothing -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.net_peer_name Text -> Maybe Text -> Maybe (Text, Attribute)
forall a.
ToAttribute a =>
Text -> Maybe a -> Maybe (Text, Attribute)
.=? (ByteString -> Text
TE.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mHost)
            Just (IPv4 IPv4
ipv4) -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.net_peer_ip Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv4 -> String
forall a. Show a => a -> String
show IPv4
ipv4)
            Just (IPv6 IPv6
ipv6) -> AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.net_peer_ip Text -> Text -> Maybe (Text, Attribute)
forall a. ToAttribute a => Text -> a -> Maybe (Text, Attribute)
.= String -> Text
T.pack (IPv6 -> String
forall a. Show a => a -> String
show IPv6
ipv6)
        ]

  semanticsOptions <- getSemanticsOptions
  pure $
    H.fromList $
      catMaybes $
        case databaseOption semanticsOptions of
          StabilityOpt
Stable -> [Maybe (Text, Attribute)]
stableMaybeAttributes
          StabilityOpt
StableAndOld -> [Maybe (Text, Attribute)]
stableMaybeAttributes [Maybe (Text, Attribute)]
-> [Maybe (Text, Attribute)] -> [Maybe (Text, Attribute)]
forall a. Eq a => [a] -> [a] -> [a]
`union` [Maybe (Text, Attribute)]
oldMaybeAttributes
          StabilityOpt
Old -> [Maybe (Text, Attribute)]
oldMaybeAttributes


extractOperationName :: C.ByteString -> Maybe T.Text
extractOperationName :: ByteString -> Maybe Text
extractOperationName ByteString
stmt =
  let trimmed :: ByteString
trimmed = (Char -> Bool) -> ByteString -> ByteString
C.dropWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t') ByteString
stmt
      keyword :: ByteString
keyword = (Char -> Bool) -> ByteString -> ByteString
C.takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\t' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') ByteString
trimmed
  in if ByteString -> Bool
C.null ByteString
keyword
       then Maybe Text
forall a. Maybe a
Nothing
       else Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
keyword


-- | Function to help with wrapping functions in postgresql-simple
pgsSpan :: HasCallStack => Connection -> C.ByteString -> IO a -> IO a
pgsSpan :: forall a. HasCallStack => Connection -> ByteString -> IO a -> IO a
pgsSpan Connection
conn ByteString
statement IO a
f = do
  connAttr <- Connection -> IO (HashMap Text Attribute)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Connection -> m (HashMap Text Attribute)
staticConnectionAttributes Connection
conn
  dbName <- maybe "unknown db" TE.decodeUtf8 <$> withConnection conn LibPQ.db
  opts <- getSemanticsOptions
  let stmtText = ByteString -> Text
TE.decodeUtf8 ByteString
statement
      mOpName = ByteString -> Maybe Text
extractOperationName ByteString
statement
      stableAttrs =
        [(Text, Attribute)] -> HashMap Text Attribute
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ([(Text, Attribute)] -> HashMap Text Attribute)
-> [(Text, Attribute)] -> HashMap Text Attribute
forall a b. (a -> b) -> a -> b
$
          (AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_query_text, Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Text
stmtText)
            (Text, Attribute) -> [(Text, Attribute)] -> [(Text, Attribute)]
forall a. a -> [a] -> [a]
: [(Text, Attribute)]
-> (Text -> [(Text, Attribute)])
-> Maybe Text
-> [(Text, Attribute)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
op -> [(AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_operation_name, Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Text
op)]) Maybe Text
mOpName
      oldAttrs = [(Text, Attribute)] -> HashMap Text Attribute
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList [(AttributeKey Text -> Text
forall a. AttributeKey a -> Text
unkey AttributeKey Text
SC.db_statement, Text -> Attribute
forall a. ToAttribute a => a -> Attribute
toAttribute Text
stmtText)]
      callAttr = case SemanticsOptions -> StabilityOpt
databaseOption SemanticsOptions
opts of
        StabilityOpt
Stable -> HashMap Text Attribute
stableAttrs
        StabilityOpt
StableAndOld -> HashMap Text Attribute
stableAttrs HashMap Text Attribute
-> HashMap Text Attribute -> HashMap Text Attribute
forall a. Semigroup a => a -> a -> a
<> HashMap Text Attribute
oldAttrs
        StabilityOpt
Old -> HashMap Text Attribute
oldAttrs
      attrs = HashMap Text Attribute
connAttr HashMap Text Attribute
-> HashMap Text Attribute -> HashMap Text Attribute
forall a. Semigroup a => a -> a -> a
<> HashMap Text Attribute
callAttr
      spanName = case Maybe Text
mOpName of
        Just Text
op -> Text
op Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dbName
        Maybe Text
Nothing -> Text
dbName
      spanArgs = SpanKind
-> HashMap Text Attribute
-> [NewLink]
-> Maybe Timestamp
-> SpanArguments
SpanArguments SpanKind
Client HashMap Text Attribute
attrs [] Maybe Timestamp
forall a. Maybe a
Nothing
  tracerProvider <- getGlobalTracerProvider
  let tracer = TracerProvider -> InstrumentationLibrary -> TracerOptions -> Tracer
makeTracer TracerProvider
tracerProvider $Addr#
Int#
Int
Text
HashMap Text Attribute
Addr# -> Int -> Text
Int# -> Int
Text -> Text -> Text -> Attributes -> InstrumentationLibrary
HashMap Text Attribute -> Int -> Int -> Attributes
forall k v. HashMap k v
empty :: Text
unpackCStringLen# :: Addr# -> Int -> Text
detectInstrumentationLibrary TracerOptions
tracerOptions
  TC.inSpan tracer spanName spanArgs f


-- | Instrumented version of 'Simple.query'
query :: (HasCallStack, MonadIO m, ToRow q, FromRow r) => Connection -> Query -> q -> m [r]
query :: forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q, FromRow r) =>
Connection -> Query -> q -> m [r]
query = RowParser r -> Connection -> Query -> q -> m [r]
forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q) =>
RowParser r -> Connection -> Query -> q -> m [r]
queryWith RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.query_'
query_ :: (HasCallStack, MonadIO m, FromRow r) => Connection -> Query -> m [r]
query_ :: forall (m :: * -> *) r.
(HasCallStack, MonadIO m, FromRow r) =>
Connection -> Query -> m [r]
query_ = RowParser r -> Connection -> Query -> m [r]
forall (m :: * -> *) r.
MonadIO m =>
RowParser r -> Connection -> Query -> m [r]
queryWith_ RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.queryWith'
queryWith :: (HasCallStack, MonadIO m, ToRow q) => Simple.RowParser r -> Connection -> Query -> q -> m [r]
queryWith :: forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q) =>
RowParser r -> Connection -> Query -> q -> m [r]
queryWith RowParser r
parser Connection
conn Query
template q
qs = IO [r] -> m [r]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> q -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template q
qs
  pgsSpan conn statement $ Simple.queryWith parser conn template qs


-- | Instrumented version of 'Simple.queryWith_'
queryWith_ :: MonadIO m => Simple.RowParser r -> Connection -> Query -> m [r]
queryWith_ :: forall (m :: * -> *) r.
MonadIO m =>
RowParser r -> Connection -> Query -> m [r]
queryWith_ RowParser r
parser Connection
conn Query
query = IO [r] -> m [r]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> () -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
query ()
  pgsSpan conn statement $ Simple.queryWith_ parser conn query


-- | Instrumented version of 'Simple.fold'
fold :: (HasCallStack, MonadUnliftIO m, FromRow row, ToRow params) => Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
fold :: forall (m :: * -> *) row params a.
(HasCallStack, MonadUnliftIO m, FromRow row, ToRow params) =>
Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
fold = FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
foldWithOptionsAndParser FoldOptions
Simple.defaultFoldOptions RowParser row
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.foldWith'
foldWith :: (HasCallStack, MonadUnliftIO m, ToRow params) => Simple.RowParser row -> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWith :: forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
RowParser row
-> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWith = FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
foldWithOptionsAndParser FoldOptions
Simple.defaultFoldOptions


-- | Instrumented version of 'Simple.foldWithOptions'
foldWithOptions :: (HasCallStack, MonadUnliftIO m, FromRow row, ToRow params) => FoldOptions -> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWithOptions :: forall (m :: * -> *) row params a.
(HasCallStack, MonadUnliftIO m, FromRow row, ToRow params) =>
FoldOptions
-> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWithOptions FoldOptions
opts = FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
foldWithOptionsAndParser FoldOptions
opts RowParser row
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.foldWithOptionsAndParser'
foldWithOptionsAndParser :: (HasCallStack, MonadUnliftIO m, ToRow params) => FoldOptions -> Simple.RowParser row -> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWithOptionsAndParser :: forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
FoldOptions
-> RowParser row
-> Connection
-> Query
-> params
-> a
-> (a -> row -> m a)
-> m a
foldWithOptionsAndParser FoldOptions
opts RowParser row
parser Connection
conn Query
template params
qs a
a a -> row -> m a
f = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> do
  statement <- Connection -> Query -> params -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template params
qs
  pgsSpan conn statement $ Simple.foldWithOptionsAndParser opts parser conn template qs a (\a
a' row
r -> m a -> IO a
forall a. m a -> IO a
runInIO (a -> row -> m a
f a
a' row
r))


-- | Instrumented version of 'Simple.fold_'
fold_ :: (HasCallStack, MonadUnliftIO m, FromRow r) => Connection -> Query -> a -> (a -> r -> m a) -> m a
fold_ :: forall (m :: * -> *) r a.
(HasCallStack, MonadUnliftIO m, FromRow r) =>
Connection -> Query -> a -> (a -> r -> m a) -> m a
fold_ = FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
forall (m :: * -> *) r a.
MonadUnliftIO m =>
FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
foldWithOptionsAndParser_ FoldOptions
Simple.defaultFoldOptions RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.foldWith_'
foldWith_ :: MonadUnliftIO m => Simple.RowParser r -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWith_ :: forall (m :: * -> *) r a.
MonadUnliftIO m =>
RowParser r -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWith_ = FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
forall (m :: * -> *) r a.
MonadUnliftIO m =>
FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
foldWithOptionsAndParser_ FoldOptions
Simple.defaultFoldOptions


-- | Instrumented version of 'Simple.foldWithOptions_'
foldWithOptions_ :: (HasCallStack, MonadUnliftIO m, FromRow r) => FoldOptions -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWithOptions_ :: forall (m :: * -> *) r a.
(HasCallStack, MonadUnliftIO m, FromRow r) =>
FoldOptions -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWithOptions_ FoldOptions
opts = FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
forall (m :: * -> *) r a.
MonadUnliftIO m =>
FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
foldWithOptionsAndParser_ FoldOptions
opts RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow


-- | Instrumented version of 'Simple.foldWithOptionsAndParser_'
foldWithOptionsAndParser_ :: MonadUnliftIO m => FoldOptions -> Simple.RowParser r -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWithOptionsAndParser_ :: forall (m :: * -> *) r a.
MonadUnliftIO m =>
FoldOptions
-> RowParser r
-> Connection
-> Query
-> a
-> (a -> r -> m a)
-> m a
foldWithOptionsAndParser_ FoldOptions
opts RowParser r
parser Connection
conn Query
q a
a a -> r -> m a
f = ((forall a. m a -> IO a) -> IO a) -> m a
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO a) -> m a)
-> ((forall a. m a -> IO a) -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInIO -> do
  statement <- Connection -> Query -> () -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
q ()
  pgsSpan conn statement $ Simple.foldWithOptionsAndParser_ opts parser conn q a (\a
a' r
r -> m a -> IO a
forall a. m a -> IO a
runInIO (a -> r -> m a
f a
a' r
r))


{- | Instrumented version of 'Simple.forEach'
 forEach :: (HasCallStack, MonadUnliftIO m, ToRow q, FromRow r) => Connection -> Query -> q -> (r -> m ()) -> m ()
-}
forEach :: p -> p -> p -> p -> Connection -> Query -> q -> (r -> m ()) -> m ()
forEach p
conn p
template p
qs p
f = RowParser r -> Connection -> Query -> q -> (r -> m ()) -> m ()
forall (m :: * -> *) q r.
(HasCallStack, MonadUnliftIO m, ToRow q) =>
RowParser r -> Connection -> Query -> q -> (r -> m ()) -> m ()
forEachWith RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow
{-# INLINE forEach #-}


-- | Instrumented version of 'Simple.forEachWith'
forEachWith :: (HasCallStack, MonadUnliftIO m, ToRow q) => Simple.RowParser r -> Connection -> Query -> q -> (r -> m ()) -> m ()
forEachWith :: forall (m :: * -> *) q r.
(HasCallStack, MonadUnliftIO m, ToRow q) =>
RowParser r -> Connection -> Query -> q -> (r -> m ()) -> m ()
forEachWith RowParser r
parser Connection
conn Query
template q
qs = RowParser r
-> Connection -> Query -> q -> () -> (() -> r -> m ()) -> m ()
forall (m :: * -> *) params row a.
(HasCallStack, MonadUnliftIO m, ToRow params) =>
RowParser row
-> Connection -> Query -> params -> a -> (a -> row -> m a) -> m a
foldWith RowParser r
parser Connection
conn Query
template q
qs () ((() -> r -> m ()) -> m ())
-> ((r -> m ()) -> () -> r -> m ()) -> (r -> m ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> m ()) -> () -> r -> m ()
forall a b. a -> b -> a
const
{-# INLINE forEachWith #-}


-- | Instrumented version of 'Simple.forEach_'
forEach_ :: (HasCallStack, MonadUnliftIO m, FromRow r) => Connection -> Query -> (r -> m ()) -> m ()
forEach_ :: forall (m :: * -> *) r.
(HasCallStack, MonadUnliftIO m, FromRow r) =>
Connection -> Query -> (r -> m ()) -> m ()
forEach_ = RowParser r -> Connection -> Query -> (r -> m ()) -> m ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
RowParser r -> Connection -> Query -> (r -> m ()) -> m ()
forEachWith_ RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow
{-# INLINE forEach_ #-}


-- | Instrumented version of 'Simple.forEachWith_'
forEachWith_ :: MonadUnliftIO m => Simple.RowParser r -> Connection -> Query -> (r -> m ()) -> m ()
forEachWith_ :: forall (m :: * -> *) r.
MonadUnliftIO m =>
RowParser r -> Connection -> Query -> (r -> m ()) -> m ()
forEachWith_ RowParser r
parser Connection
conn Query
template = RowParser r
-> Connection -> Query -> () -> (() -> r -> m ()) -> m ()
forall (m :: * -> *) r a.
MonadUnliftIO m =>
RowParser r -> Connection -> Query -> a -> (a -> r -> m a) -> m a
foldWith_ RowParser r
parser Connection
conn Query
template () ((() -> r -> m ()) -> m ())
-> ((r -> m ()) -> () -> r -> m ()) -> (r -> m ()) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> m ()) -> () -> r -> m ()
forall a b. a -> b -> a
const
{-# INLINE forEachWith_ #-}


-- | Instrumented version of 'Simple.returning'
returning :: (HasCallStack, MonadIO m, ToRow q, FromRow r) => Connection -> Query -> [q] -> m [r]
returning :: forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q, FromRow r) =>
Connection -> Query -> [q] -> m [r]
returning = RowParser r -> Connection -> Query -> [q] -> m [r]
forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q) =>
RowParser r -> Connection -> Query -> [q] -> m [r]
returningWith RowParser r
forall a. FromRow a => RowParser a
Simple.fromRow


-- | A version of 'returning' taking parser as argument
returningWith :: (HasCallStack, MonadIO m, ToRow q) => Simple.RowParser r -> Connection -> Query -> [q] -> m [r]
returningWith :: forall (m :: * -> *) q r.
(HasCallStack, MonadIO m, ToRow q) =>
RowParser r -> Connection -> Query -> [q] -> m [r]
returningWith RowParser r
_parser Connection
_conn Query
_q [] = [r] -> m [r]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
returningWith RowParser r
parser Connection
conn Query
q [q]
qs = IO [r] -> m [r]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [r] -> m [r]) -> IO [r] -> m [r]
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> [q] -> IO ByteString
forall q. ToRow q => Connection -> Query -> [q] -> IO ByteString
formatMany Connection
conn Query
q [q]
qs
  pgsSpan conn statement $ Simple.returningWith parser conn q qs


-- | Instrumented version of 'Simple.execute'
execute :: (HasCallStack, MonadIO m, ToRow q) => Connection -> Query -> q -> m Int64
execute :: forall (m :: * -> *) q.
(HasCallStack, MonadIO m, ToRow q) =>
Connection -> Query -> q -> m Int64
execute Connection
conn Query
template q
qs = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> q -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
template q
qs
  pgsSpan conn statement $ Simple.execute conn template qs


-- | Instrumented version of 'Simple.execute_'
execute_ :: MonadIO m => Connection -> Query -> m Int64
execute_ :: forall (m :: * -> *). MonadIO m => Connection -> Query -> m Int64
execute_ Connection
conn Query
q = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> () -> IO ByteString
forall q. ToRow q => Connection -> Query -> q -> IO ByteString
formatQuery Connection
conn Query
q ()
  pgsSpan conn statement $ Simple.execute_ conn q


-- | Instrumented version of 'Simple.executeMany'
executeMany :: (HasCallStack, MonadIO m, ToRow q) => Connection -> Query -> [q] -> m Int64
executeMany :: forall (m :: * -> *) q.
(HasCallStack, MonadIO m, ToRow q) =>
Connection -> Query -> [q] -> m Int64
executeMany Connection
_conn Query
_q [] = Int64 -> m Int64
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
executeMany Connection
conn Query
q [q]
qs = IO Int64 -> m Int64
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
  statement <- Connection -> Query -> [q] -> IO ByteString
forall q. ToRow q => Connection -> Query -> [q] -> IO ByteString
formatMany Connection
conn Query
q [q]
qs
  pgsSpan conn statement $ Simple.executeMany conn q qs