diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +# hpqtypes-1.9.2.0 (2021-09-29) +* Add method withFrozenLastQuery to (temporarily) stop recording queries. + # hpqtypes-1.9.1.2 (2021-07-29) * Fix compilation issues caused by ambiguos occurence of `controlT`. diff --git a/hpqtypes.cabal b/hpqtypes.cabal --- a/hpqtypes.cabal +++ b/hpqtypes.cabal @@ -1,5 +1,5 @@ name: hpqtypes -version: 1.9.1.2 +version: 1.9.2.0 synopsis: Haskell bindings to libpqtypes description: Efficient and easy-to-use bindings to (slightly modified) diff --git a/src/Database/PostgreSQL/PQTypes/Class.hs b/src/Database/PostgreSQL/PQTypes/Class.hs --- a/src/Database/PostgreSQL/PQTypes/Class.hs +++ b/src/Database/PostgreSQL/PQTypes/Class.hs @@ -22,6 +22,9 @@ runQuery :: IsSQL sql => sql -> m Int -- | Get last SQL query that was executed. getLastQuery :: m SomeSQL + -- | Subsequent queries in the callback do not alter the result of + -- 'getLastQuery'. + withFrozenLastQuery :: m a -> m a -- | Get current connection statistics. getConnectionStats :: m ConnectionStats @@ -73,6 +76,7 @@ ) => MonadDB (t m) where runQuery = lift . runQuery getLastQuery = lift getLastQuery + withFrozenLastQuery m = controlT $ \run -> withFrozenLastQuery (run m) getConnectionStats = lift getConnectionStats getQueryResult = lift getQueryResult clearQueryResult = lift clearQueryResult @@ -82,6 +86,7 @@ withNewConnection m = controlT $ \run -> withNewConnection (run m) {-# INLINE runQuery #-} {-# INLINE getLastQuery #-} + {-# INLINE withFrozenLastQuery #-} {-# INLINE getConnectionStats #-} {-# INLINE getQueryResult #-} {-# INLINE clearQueryResult #-} diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs b/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs --- a/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Monad.hs @@ -54,6 +54,7 @@ , dbConnectionSource = cs , dbTransactionSettings = ts , dbLastQuery = SomeSQL (mempty::SQL) + , dbRecordLastQuery = True , dbQueryResult = Nothing } where @@ -76,6 +77,11 @@ runQuery sql = DBT . StateT $ liftBase . runQueryIO sql getLastQuery = DBT . gets $ dbLastQuery + withFrozenLastQuery callback = DBT . StateT $ \st -> do + let st' = st { dbRecordLastQuery = False } + (x, st'') <- runStateT (unDBT callback) st' + pure (x, st'' { dbRecordLastQuery = dbRecordLastQuery st }) + getConnectionStats = do mconn <- DBT $ liftBase . readMVar =<< gets (unConnection . dbConnection) case mconn of @@ -99,6 +105,7 @@ {-# INLINABLE runQuery #-} {-# INLINABLE getLastQuery #-} + {-# INLINABLE withFrozenLastQuery #-} {-# INLINABLE getConnectionStats #-} {-# INLINABLE getQueryResult #-} {-# INLINABLE clearQueryResult #-} diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Query.hs b/src/Database/PostgreSQL/PQTypes/Internal/Query.hs --- a/src/Database/PostgreSQL/PQTypes/Internal/Query.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Query.hs @@ -73,7 +73,7 @@ rethrowWithContext sql . E.toException $ HPQTypesError ("PQcancel failed: " ++ err) return (affected, st { - dbLastQuery = SomeSQL sql + dbLastQuery = if dbRecordLastQuery st then SomeSQL sql else dbLastQuery st , dbQueryResult = Just QueryResult { qrSQL = SomeSQL sql , qrResult = res diff --git a/src/Database/PostgreSQL/PQTypes/Internal/State.hs b/src/Database/PostgreSQL/PQTypes/Internal/State.hs --- a/src/Database/PostgreSQL/PQTypes/Internal/State.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/State.hs @@ -19,6 +19,8 @@ , dbTransactionSettings :: !TransactionSettings -- | Last SQL query that was executed. , dbLastQuery :: !SomeSQL + -- | Whether running query should override 'dbLastQuery'. + , dbRecordLastQuery :: !Bool -- | Current query result. , dbQueryResult :: !(forall row. FromRow row => Maybe (QueryResult row)) } diff --git a/src/Database/PostgreSQL/PQTypes/Interval.hs b/src/Database/PostgreSQL/PQTypes/Interval.hs new file mode 100644 --- /dev/null +++ b/src/Database/PostgreSQL/PQTypes/Interval.hs @@ -0,0 +1,153 @@ +{-# LINE 1 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} +module Database.PostgreSQL.PQTypes.Interval ( + Interval(..) + , iyears + , imonths + , idays + , ihours + , iminutes + , iseconds + , imicroseconds + ) where + +import Data.Int +import Data.List +import Foreign.Storable +import qualified Data.ByteString.Char8 as BS +import qualified Data.Semigroup as SG + +import Database.PostgreSQL.PQTypes.Format +import Database.PostgreSQL.PQTypes.FromSQL +import Database.PostgreSQL.PQTypes.Internal.Utils +import Database.PostgreSQL.PQTypes.ToSQL + + + +---------------------------------------- + +-- | Representation of INTERVAL PostgreSQL type. +data Interval = Interval + { intYears :: !Int32 + , intMonths :: !Int32 + , intDays :: !Int32 + , intHours :: !Int32 + , intMinutes :: !Int32 + , intSeconds :: !Int32 + , intMicroseconds :: !Int32 + } deriving (Eq, Ord) + +instance Show Interval where + showsPrec _ Interval{..} = (++) . intercalate ", " $ filter (not . null) [ + f intYears "year" + , f intMonths "month" + , f intDays "day" + , f intHours "hour" + , f intMinutes "minute" + , f intSeconds "second" + , f intMicroseconds "microsecond" + ] + where + f n desc = case n of + 0 -> "" + 1 -> show n ++ " " ++ desc + _ -> show n ++ " " ++ desc ++ "s" + +instance SG.Semigroup Interval where + a <> b = Interval { + intYears = intYears a + intYears b + , intMonths = intMonths a + intMonths b + , intDays = intDays a + intDays b + , intHours = intHours a + intHours b + , intMinutes = intMinutes a + intMinutes b + , intSeconds = intSeconds a + intSeconds b + , intMicroseconds = intMicroseconds a + intMicroseconds b + } + +instance Monoid Interval where + mempty = Interval 0 0 0 0 0 0 0 + mappend = (SG.<>) + +instance Storable Interval where + sizeOf _ = (28) +{-# LINE 71 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + alignment _ = 4 +{-# LINE 72 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + peek ptr = Interval + <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr +{-# LINE 74 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr +{-# LINE 75 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr +{-# LINE 76 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr +{-# LINE 77 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr +{-# LINE 78 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr +{-# LINE 79 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + <*> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr +{-# LINE 80 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + poke ptr Interval{..} = do + (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr intYears +{-# LINE 82 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr intMonths +{-# LINE 83 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr intDays +{-# LINE 84 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr intHours +{-# LINE 85 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr intMinutes +{-# LINE 86 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr intSeconds +{-# LINE 87 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr intMicroseconds +{-# LINE 88 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-} + +instance PQFormat Interval where + pqFormat = BS.pack "%interval" + +instance FromSQL Interval where + type PQBase Interval = Interval + fromSQL Nothing = unexpectedNULL + fromSQL (Just int) = return int + +instance ToSQL Interval where + type PQDest Interval = Interval + toSQL int _ = putAsPtr int + +---------------------------------------- + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of years. +iyears :: Int32 -> Interval +iyears v = mempty { intYears = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of months. +imonths :: Int32 -> Interval +imonths v = mempty { intMonths = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of days. +idays :: Int32 -> Interval +idays v = mempty { intDays = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of hours. +ihours :: Int32 -> Interval +ihours v = mempty { intHours = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of minutes. +iminutes :: Int32 -> Interval +iminutes v = mempty { intMinutes = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of seconds. +iseconds :: Int32 -> Interval +iseconds v = mempty { intSeconds = v } + +-- | Convert 'Int32' to appropriate 'Interval' +-- representation of given number of microseconds. +imicroseconds :: Int32 -> Interval +imicroseconds v = mempty { intMicroseconds = v }