diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,17 +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 + + * 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/Database/Beam/Sqlite/Connection.hs b/Database/Beam/Sqlite/Connection.hs --- a/Database/Beam/Sqlite/Connection.hs +++ b/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 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.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 (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 @@ 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/Database/Beam/Sqlite/Migrate.hs b/Database/Beam/Sqlite/Migrate.hs --- a/Database/Beam/Sqlite/Migrate.hs +++ b/Database/Beam/Sqlite/Migrate.hs @@ -3,8 +3,7 @@ -- | Migrations support for SQLite databases module Database.Beam.Sqlite.Migrate - ( -- * @beam-migrate@ CLI support - migrationBackend, SqliteCommandSyntax + ( migrationBackend, SqliteCommandSyntax -- * @beam-migrate@ utility functions , migrateScript, writeMigrationScript @@ -48,8 +47,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE --- | Top-level 'Tool.BeamMigrationBackend' loaded dynamically by the --- @beam-migrate@ CLI tool. +-- | Top-level 'Tool.BeamMigrationBackend' migrationBackend :: Tool.BeamMigrationBackend Sqlite SqliteM migrationBackend = Tool.BeamMigrationBackend "sqlite" diff --git a/Database/Beam/Sqlite/Syntax.hs b/Database/Beam/Sqlite/Syntax.hs --- a/Database/Beam/Sqlite/Syntax.hs +++ b/Database/Beam/Sqlite/Syntax.hs @@ -68,6 +68,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Time +import qualified Data.Time.Format.ISO8601 as Time import Data.Word #if !MIN_VERSION_base(4, 11, 0) import Data.Semigroup @@ -105,12 +106,11 @@ displaySyntax = BL.unpack . sqliteRenderSyntaxScript instance Semigroup SqliteSyntax where - (<>) = mappend + (<>) (SqliteSyntax ab av) (SqliteSyntax bb bv) = + SqliteSyntax (\v -> ab v <> bb v) (av <> bv) instance Monoid SqliteSyntax where mempty = SqliteSyntax (\_ -> mempty) mempty - mappend (SqliteSyntax ab av) (SqliteSyntax bb bv) = - SqliteSyntax (\v -> ab v <> bb v) (av <> bv) instance Eq SqliteSyntax where SqliteSyntax ab av == SqliteSyntax bb bv = @@ -967,12 +967,10 @@ sqlValueSyntax tm = SqliteValueSyntax (emitValue (toField tm)) instance HasSqlValueSyntax SqliteValueSyntax LocalTime where - sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString tmStr))) - where tmStr = formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%S%Q")) tm + sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString (Time.formatShow Time.iso8601Format tm)))) instance HasSqlValueSyntax SqliteValueSyntax Day where - sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString tmStr))) - where tmStr = formatTime defaultTimeLocale (iso8601DateFormat Nothing) tm + sqlValueSyntax tm = SqliteValueSyntax (emitValue (SQLText (fromString (Time.formatShow Time.iso8601Format tm)))) instance HasDataTypeCreatedCheck SqliteDataTypeSyntax where dataTypeHasBeenCreated _ _ = True diff --git a/beam-sqlite.cabal b/beam-sqlite.cabal --- a/beam-sqlite.cabal +++ b/beam-sqlite.cabal @@ -1,5 +1,5 @@ name: beam-sqlite -version: 0.5.3.0 +version: 0.5.4.0 synopsis: Beam driver for SQLite description: Beam driver for the embedded database. See @@ -29,9 +29,9 @@ beam-migrate >=0.5 && <0.6, sqlite-simple >=0.4 && <0.5, - text >=1.0 && <2.1, - bytestring >=0.10 && <0.12, - hashable >=1.2 && <1.5, + text >=1.0 && <2.2, + bytestring >=0.10 && <0.13, + hashable >=1.2 && <1.6, time >=1.6 && <1.13, dlist >=0.8 && <1.1, mtl >=2.1 && <2.4, @@ -39,7 +39,7 @@ scientific >=0.3 && <0.4, monad-control >=1.0 && <1.1, network-uri >=2.6 && <2.7, - aeson >=0.11 && <2.2, + aeson >=0.11 && <2.3, attoparsec >=0.13 && <0.15, transformers-base >=0.4 && <0.5 default-language: Haskell2010 @@ -49,13 +49,6 @@ ghc-options: -Wall 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