From 63dfa08cccad1664dce2adb2aef5784e6177ca03 Mon Sep 17 00:00:00 2001 From: Laurent Rene de Cotret Date: Thu, 2 Jan 2025 20:52:55 -0500 Subject: [PATCH] Remove direct dependence of `beam-sqlite` on either `unix` or `windows`, allowing to build on a wider variety of platforms --- beam-sqlite/ChangeLog.md | 15 ++++-- .../Database/Beam/Sqlite/Connection.hs | 46 ++++++++----------- beam-sqlite/beam-sqlite.cabal | 9 +--- 3 files changed, 31 insertions(+), 39 deletions(-) diff --git a/beam-sqlite/ChangeLog.md b/beam-sqlite/ChangeLog.md index a0c7b579..977127b6 100644 --- a/beam-sqlite/ChangeLog.md +++ b/beam-sqlite/ChangeLog.md @@ -1,23 +1,30 @@ +# 0.5.4.0 + +## Added features + + * Removed the reliance on either the `unix` or `windows` package, which should enable (#738) + `beam-sqlite` to be buildable on a wider variety of platforms. + # 0.5.3.1 -# Added features +## Added features * Replaced use of deprecated functions. # 0.5.3.0 -# Added features +## Added features * Loosen some version bounds * `HasSqlEqualityCheck` instance for `Day` # 0.5.2.0 -# Bug fixes +## Bug fixes * Fix encoding for `UTCTime` -# Addded features +## Addded features * `IN (SELECT ...)` syntax via `inQuery_` diff --git a/beam-sqlite/Database/Beam/Sqlite/Connection.hs b/beam-sqlite/Database/Beam/Sqlite/Connection.hs index bfc462a5..2307fc5a 100644 --- a/beam-sqlite/Database/Beam/Sqlite/Connection.hs +++ b/beam-sqlite/Database/Beam/Sqlite/Connection.hs @@ -1,6 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE UndecidableInstances #-} @@ -72,6 +71,7 @@ import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BL import qualified Data.DList as D +import Data.Hashable (hash) import Data.Int import Data.Maybe (mapMaybe) import Data.Proxy (Proxy(..)) @@ -82,21 +82,13 @@ import qualified Data.Text.Encoding as T (decodeUtf8) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL (decodeUtf8) import Data.Time ( LocalTime, UTCTime, Day - , ZonedTime, utc, utcToLocalTime ) + , ZonedTime, utc, utcToLocalTime, getCurrentTime ) import Data.Typeable (cast) import Data.Word import GHC.TypeLits import Network.URI -#ifdef UNIX -import System.Posix.Process (getProcessID) -#elif defined(WINDOWS) -import System.Win32.Process (getCurrentProcessId) -#else -#error Need either POSIX or Win32 API for MonadBeamInsertReturning -#endif - import Text.Read (readMaybe) -- | The SQLite backend. Used to parameterize 'MonadBeam' and 'FromBackendRow' @@ -388,34 +380,34 @@ runInsertReturningList SqlInsertNoRows = pure [] runInsertReturningList (SqlInsert tblSettings insertStmt_@(SqliteInsertSyntax nm _ _ _)) = do (logger, conn) <- SqliteM ask SqliteM . liftIO $ do - -#ifdef UNIX - processId <- fromString . show <$> getProcessID -#elif defined(WINDOWS) - processId <- fromString . show <$> getCurrentProcessId -#else -#error Need either POSIX or Win32 API for MonadBeamInsertReturning -#endif + + -- We create a pseudo-random savepoint identification that can be referenced + -- throughout this operation. -- This used to be based on the process ID + -- (e.g. `System.Posix.Process.getProcessID` for UNIX), + -- but using timestamps is more portable; see #738 + -- + -- Note that `hash` can return negative numbers, hence the use of `abs`. + savepointId <- fromString . show . abs . hash <$> getCurrentTime let tableNameTxt = T.decodeUtf8 (BL.toStrict (sqliteRenderSyntaxScript (fromSqliteTableName nm))) startSavepoint = - execute_ conn (Query ("SAVEPOINT insert_savepoint_" <> processId)) + execute_ conn (Query ("SAVEPOINT insert_savepoint_" <> savepointId)) rollbackToSavepoint = - execute_ conn (Query ("ROLLBACK TRANSACTION TO SAVEPOINT insert_savepoint_" <> processId)) + execute_ conn (Query ("ROLLBACK TRANSACTION TO SAVEPOINT insert_savepoint_" <> savepointId)) releaseSavepoint = - execute_ conn (Query ("RELEASE SAVEPOINT insert_savepoint_" <> processId)) + execute_ conn (Query ("RELEASE SAVEPOINT insert_savepoint_" <> savepointId)) createInsertedValuesTable = - execute_ conn (Query ("CREATE TEMPORARY TABLE inserted_values_" <> processId <> " AS SELECT * FROM " <> tableNameTxt <> " LIMIT 0")) + execute_ conn (Query ("CREATE TEMPORARY TABLE inserted_values_" <> savepointId <> " AS SELECT * FROM " <> tableNameTxt <> " LIMIT 0")) dropInsertedValuesTable = - execute_ conn (Query ("DROP TABLE inserted_values_" <> processId)) + execute_ conn (Query ("DROP TABLE inserted_values_" <> savepointId)) createInsertTrigger = - execute_ conn (Query ("CREATE TEMPORARY TRIGGER insert_trigger_" <> processId <> " AFTER INSERT ON " <> tableNameTxt <> " BEGIN " <> - "INSERT INTO inserted_values_" <> processId <> " SELECT * FROM " <> tableNameTxt <> " WHERE ROWID=last_insert_rowid(); END" )) + execute_ conn (Query ("CREATE TEMPORARY TRIGGER insert_trigger_" <> savepointId <> " AFTER INSERT ON " <> tableNameTxt <> " BEGIN " <> + "INSERT INTO inserted_values_" <> savepointId <> " SELECT * FROM " <> tableNameTxt <> " WHERE ROWID=last_insert_rowid(); END" )) dropInsertTrigger = - execute_ conn (Query ("DROP TRIGGER insert_trigger_" <> processId)) + execute_ conn (Query ("DROP TRIGGER insert_trigger_" <> savepointId)) mask $ \restore -> do @@ -430,7 +422,7 @@ runInsertReturningList (SqlInsert tblSettings insertStmt_@(SqliteInsertSyntax nm allBeamValues (\(Columnar' projField) -> quotedIdentifier (_fieldName projField)) $ tblSettings - fmap (\(BeamSqliteRow r) -> r) <$> query_ conn (Query ("SELECT " <> columns <> " FROM inserted_values_" <> processId)) + fmap (\(BeamSqliteRow r) -> r) <$> query_ conn (Query ("SELECT " <> columns <> " FROM inserted_values_" <> savepointId)) releaseSavepoint return x diff --git a/beam-sqlite/beam-sqlite.cabal b/beam-sqlite/beam-sqlite.cabal index 8de64d1c..4bd56f25 100644 --- a/beam-sqlite/beam-sqlite.cabal +++ b/beam-sqlite/beam-sqlite.cabal @@ -1,5 +1,5 @@ name: beam-sqlite -version: 0.5.3.1 +version: 0.5.4.0 synopsis: Beam driver for SQLite description: Beam driver for the embedded database. See @@ -50,13 +50,6 @@ library if flag(werror) ghc-options: -Werror - if os(windows) - cpp-options: -DWINDOWS - build-depends: Win32 >=2.4 && <2.8 - if os(freebsd) || os(netbsd) || os(openbsd) || os(darwin) || os(linux) || os(solaris) || os(android) - cpp-options: -DUNIX - build-depends: unix >=2.0 && <2.9 - test-suite beam-sqlite-tests type: exitcode-stdio-1.0 hs-source-dirs: test