hpqtypes-effectful 1.0.1.0 → 1.0.2.0
raw patch · 4 files changed
+27/−16 lines, 4 filesdep ~basedep ~hpqtypesPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, hpqtypes
API changes (from Hackage documentation)
+ Effectful.HPQTypes: [GetBackendPid] :: DB m BackendPid
Files
- CHANGELOG.md +4/−1
- hpqtypes-effectful.cabal +5/−6
- src/Effectful/HPQTypes.hs +16/−7
- test/Main.hs +2/−2
CHANGELOG.md view
@@ -1,5 +1,8 @@-# hpqtypes-effectful-1.0.1.0 (2023-12-18)+# hpqtypes-effectful-1.0.2.0 (2024-03-18) * Compatibility with `hpqtypes` >= 1.12.0.0.++# hpqtypes-effectful-1.0.1.0 (2023-12-18)+* ~~Compatibility with `hpqtypes` >= 1.12.0.0.~~ # hpqtypes-effectful-1.0.0.1 (2023-03-28) * Compatibility with `hpqtypes` >= 1.11.1.0.
hpqtypes-effectful.cabal view
@@ -1,7 +1,7 @@-cabal-version: 2.4+cabal-version: 3.0 build-type: Simple name: hpqtypes-effectful-version: 1.0.1.0+version: 1.0.2.0 license: BSD-3-Clause license-file: LICENSE category: Database@@ -16,8 +16,7 @@ CHANGELOG.md README.md -tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3- || ==9.8.1+tested-with: GHC == { 8.10.7, 9.0.2, 9.2.8, 9.4.8, 9.6.4, 9.8.2 } bug-reports: https://github.com/haskell-effectful/hpqtypes-effectful/issues source-repository head@@ -56,10 +55,10 @@ library import: language - build-depends: base >= 4.13 && < 5+ build-depends: base >= 4.14 && < 5 , effectful-core >= 1.2.0.0 && < 3.0.0.0 , exceptions- , hpqtypes >= 1.11.1.0 && < 1.13.0.0+ , hpqtypes >= 1.12.0.0 && < 1.13.0.0 hs-source-dirs: src
src/Effectful/HPQTypes.hs view
@@ -31,6 +31,7 @@ RunQuery :: IsSQL sql => sql -> DB m Int GetQueryResult :: FromRow row => DB m (Maybe (QueryResult row)) ClearQueryResult :: DB m ()+ GetBackendPid :: DB m BackendPid GetConnectionStats :: DB m PQ.ConnectionStats RunPreparedQuery :: IsSQL sql => PQ.QueryName -> sql -> DB m Int GetLastQuery :: DB m SomeSQL@@ -47,6 +48,7 @@ runQuery = withFrozenCallStack $ send . RunQuery getQueryResult = send GetQueryResult clearQueryResult = send ClearQueryResult+ getBackendPid = send GetBackendPid getConnectionStats = withFrozenCallStack $ send GetConnectionStats runPreparedQuery qn = withFrozenCallStack $ send . RunPreparedQuery qn getLastQuery = send GetLastQuery@@ -62,7 +64,7 @@ -- /Note:/ this is the @effectful@ version of 'runDBT'. runDB :: forall es a- . (IOE :> es)+ . IOE :> es => PQ.ConnectionSourceM (Eff es) -- ^ Connection source. -> TransactionSettings@@ -74,6 +76,7 @@ RunQuery sql -> unDBEff $ runQuery sql GetQueryResult -> unDBEff getQueryResult ClearQueryResult -> unDBEff clearQueryResult+ GetBackendPid -> unDBEff getBackendPid GetConnectionStats -> unDBEff getConnectionStats RunPreparedQuery queryName sql -> unDBEff $ runPreparedQuery queryName sql GetLastQuery -> unDBEff getLastQuery@@ -145,7 +148,7 @@ type DBState es = PQ.DBState (Eff es) -- Convenience `MonadIO` instance-instance (IOE :> es) => MonadIO (DBEff es) where+instance IOE :> es => MonadIO (DBEff es) where liftIO b = DBEff $ liftIO b get :: DBEff es (DBState es)@@ -157,11 +160,13 @@ modify :: (DBState es -> DBState es) -> DBEff es () modify = DBEff . State.modify -instance (IOE :> es) => MonadDB (DBEff es) where+instance IOE :> es => MonadDB (DBEff es) where runQuery sql = do dbState <- get- (rows, res) <- liftIO $ PQ.runQueryIO (PQ.dbConnection dbState) sql- put $ PQ.updateStateWith dbState sql res+ (rows, newDbState) <- liftIO $ do+ PQ.updateStateWith dbState sql+ =<< PQ.runQueryIO (PQ.dbConnection dbState) sql+ put newDbState pure rows getQueryResult =@@ -170,6 +175,8 @@ clearQueryResult = modify $ \st -> st {PQ.dbQueryResult = Nothing} + getBackendPid = liftIO . PQ.getBackendPidIO . PQ.dbConnection =<< get+ getConnectionStats = do dbState <- get mconn <- liftIO . readMVar . PQ.unConnection $ PQ.dbConnection dbState@@ -179,8 +186,10 @@ runPreparedQuery queryName sql = do dbState <- get- (rows, res) <- liftIO $ PQ.runPreparedQueryIO (PQ.dbConnection dbState) queryName sql- put $ PQ.updateStateWith dbState sql res+ (rows, newDbState) <- liftIO $ do+ PQ.updateStateWith dbState sql+ =<< PQ.runPreparedQueryIO (PQ.dbConnection dbState) queryName sql+ put newDbState pure rows getLastQuery = PQ.dbLastQuery <$> get
test/Main.hs view
@@ -73,14 +73,14 @@ runQuery_ $ mkSQL "SELECT 1" runQuery_ $ mkSQL "SELECT 2" connectionStats <- getConnectionStats- liftIO $ assertEqual "Incorrect connection stats" (ConnectionStats 2 2 2 0) connectionStats+ liftIO $ assertEqual "Incorrect connection stats" (ConnectionStats 3 3 3 0) connectionStats do runQuery_ $ mkSQL "CREATE TABLE some_table (field INT)" runQuery_ $ mkSQL "BEGIN" runQuery_ $ mkSQL "INSERT INTO some_table VALUES (1)" withNewConnection $ do connectionStats <- getConnectionStats- liftIO $ assertEqual "Connection stats should be reset" (ConnectionStats 0 0 0 0) connectionStats+ liftIO $ assertEqual "Connection stats should be reset" (ConnectionStats 1 1 1 0) connectionStats noOfResults <- runQuery $ mkSQL "SELECT * FROM some_table" liftIO $ assertEqual "Results should not be visible yet" 0 noOfResults runQuery_ $ mkSQL "COMMIT"