beam-sqlite 0.5.6.0 → 0.5.7.0

raw patch · 5 files changed

+124/−5 lines, 5 filesdep ~beam-migratePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: beam-migrate

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−1
• Database/Beam/Sqlite/Migrate.hs +29/−1
• Database/Beam/Sqlite/Syntax.hs +35/−1
• beam-sqlite.cabal +2/−2
• test/Database/Beam/Sqlite/Test/Migrate.hs +49/−0

@@ -1,3 +1,11 @@+# 0.5.7.0++## Added features++* Add support for creating secondary indices (`CREATE INDEX` and+  `CREATE UNIQUE INDEX`), including discovering user-created secondary indices+  via `PRAGMA index_list` / `PRAGMA index_info`.+ # 0.5.6.0  ## Performance optimizations@@ -13,7 +21,7 @@  ## Bux fixes -* Fixed an issue where values inserted with conflicts did not return then when using `runInsertReturningList` (#774) +* Fixed an issue where values inserted with conflicts did not return then when using `runInsertReturningList` (#774)  ## Updated dependencies 

@@ -41,6 +41,7 @@ import           Data.Char (isSpace) import           Data.Int (Int64) import           Data.List (sortBy)+import qualified Data.List.NonEmpty as NE (nonEmpty) import           Data.Maybe (mapMaybe, isJust) import           Data.Monoid (Endo(..)) import           Data.Ord (comparing)@@ -64,6 +65,8 @@     , Tool.backendFileExtension = "sqlite.sql"     , Tool.backendConvertToHaskell = sqlitePredConverter     , Tool.backendActionProvider = Db.defaultActionProvider+                                <> Db.createIndexActionProvider+                                <> Db.dropIndexActionProvider     , Tool.backendRunSqlScript = runSqlScript     , Tool.backendWithTransaction =         \(SqliteM go) ->@@ -320,8 +323,33 @@             pkPred = case pkColumns of                        [] -> []                        _  -> [ Db.SomeDatabasePredicate (Db.TableHasPrimaryKey tblName pkColumns) ]++        -- Collect user-created secondary indices (origin = 'c') for this table.+        -- SQLite's PRAGMA index_list returns (seq, name, unique, origin, partial).+        -- PRAGMA index_info returns (seqno, cid, name) ordered by seqno.+        idxRows <- query_ conn (fromString ("PRAGMA index_list('" <> T.unpack tblNameStr <> "')")+                           ) :: IO [(Int, T.Text, Int, T.Text, Int)]+        idxPreds <- fmap concat . forM idxRows $+          \(_, idxNm, isUniq, origin, _) ->+            if origin /= T.pack "c"+            then pure []+            else do+              colRows <- query_ conn (fromString ("PRAGMA index_info('" <> T.unpack idxNm <> "')")+                             ) :: IO [(Int, Int, T.Text)]+              let cols = map (\(_, _, nm) -> nm) $+                         sortBy (comparing (\(seqno, _, _) -> seqno)) colRows+              pure $+                case NE.nonEmpty cols of+                  Nothing -> []+                  Just colsNE ->+                    let opts = Db.setUniqueIndexOptions @SqliteCommandSyntax (isUniq /= (0 :: Int))+                             $ Db.defaultIndexOptions @SqliteCommandSyntax+                    in+                      [ Db.SomeDatabasePredicate+                          (Db.TableHasIndex @Sqlite tblName idxNm colsNE opts) ]+         pure ( [ Db.SomeDatabasePredicate (Db.TableExistsPredicate tblName) ]-             ++ pkPred ++ columnPreds )+             ++ pkPred ++ columnPreds ++ idxPreds )      pure tblPreds 

@@ -26,6 +26,7 @@   , SqliteTableNameSyntax(..)   , SqliteFieldNameSyntax(..)   , SqliteAggregationSetQuantifierSyntax(..)+  , SqliteIndexOptions(..)    , fromSqliteExpression @@ -55,7 +56,7 @@ import qualified Database.Beam.Migrate.Serialization as Db import           Database.Beam.Query hiding (ExtractField(..)) -import           Data.Aeson (object, (.=))+import           Data.Aeson (object, withObject, (.=), (.:)) import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.ByteString.Builder@@ -64,6 +65,7 @@ import qualified Data.DList as DL import           Data.Hashable import           Data.Int+import qualified Data.List.NonEmpty as NE (toList) import           Data.Maybe import           Data.Scientific import           Data.String@@ -981,3 +983,35 @@  instance HasDataTypeCreatedCheck SqliteDataTypeSyntax where   dataTypeHasBeenCreated _ _ = True++newtype SqliteIndexOptions =+  SqliteIndexOptions { sqliteIndexUnique :: Bool }+    deriving (Show, Eq, Hashable)++instance IsSql92CreateDropIndexSyntax SqliteCommandSyntax where+  type instance Sql92CreateIndexOptionsSyntax SqliteCommandSyntax =+    SqliteIndexOptions++  defaultIndexOptions = SqliteIndexOptions { sqliteIndexUnique = False }++  createIndexCmd idxNm tblNm cols opts =+    SqliteCommandSyntax $+    emit (if sqliteIndexUnique opts then "CREATE UNIQUE INDEX " else "CREATE INDEX ") <>+    quotedIdentifier idxNm <>+    emit " ON " <> fromSqliteTableName tblNm <>+    parens (commas (NE.toList $ fmap quotedIdentifier cols))++  dropIndexCmd idxNm =+    SqliteCommandSyntax (emit "DROP INDEX " <> quotedIdentifier idxNm)++  serializeIndexOptions opts =+    object ["unique" .= sqliteIndexUnique opts]++  deserializeIndexOptions =+    withObject "SqliteIndexOptions" $ \v ->+      SqliteIndexOptions <$> v .: "unique"++instance IsSql92UniqueIndexSyntax SqliteCommandSyntax where++  setUniqueIndexOptions u opts = opts { sqliteIndexUnique = u }+  indexIsUnique opts = sqliteIndexUnique opts

@@ -1,5 +1,5 @@ name:                beam-sqlite-version:             0.5.6.0+version:             0.5.7.0 synopsis:            Beam driver for SQLite description:         Beam driver for the <https://sqlite.org/ SQLite> embedded database.                      See <https://haskell-beam.github.io/beam/user-guide/backends/beam-sqlite/ here>@@ -26,7 +26,7 @@   build-depends:      base          >=4.11 && <5,                        beam-core     >=0.10 && <0.11,-                      beam-migrate  >=0.5.3.2  && <0.6,+                      beam-migrate  >=0.5.4.0  && <0.6,                        sqlite-simple >=0.4  && <0.5,                       containers    >=0.6  && <0.9,

@@ -4,6 +4,8 @@ import Test.Tasty import Test.Tasty.HUnit +import qualified Data.List.NonEmpty as NE+import Data.Int (Int32) import Database.Beam import Database.Beam.Sqlite import Database.Beam.Sqlite.Migrate@@ -11,11 +13,14 @@ import Database.Beam.Migrate.Simple  import Database.Beam.Sqlite.Test+import Database.Beam.Sqlite.Syntax (SqliteIndexOptions)  tests :: TestTree tests = testGroup "Migration tests"   [ verifiesPrimaryKey   , verifiesNoPrimaryKey+  , verifiesIndex+  , verifiesUniqueIndex   ]  newtype WithPkT f = WithPkT@@ -72,3 +77,47 @@     VerificationSucceeded -> return ()     VerificationFailed failures ->       fail $ "Verification failed: " ++ show failures++-- Shared table type for index tests++newtype IdxT f = IdxT+  { _idx_value :: C f Int32+  } deriving (Generic, Beamable)++instance Table IdxT where+  newtype PrimaryKey IdxT f = IdxPk (C f Int32)+    deriving (Generic, Beamable)+  primaryKey = IdxPk . _idx_value++data IdxDb entity = IdxDb+  { _idx_tbl :: entity (TableEntity IdxT)+  } deriving (Generic, Database Sqlite)++verifiesIndex :: TestTree+verifiesIndex = testCase "verifySchema correctly detects a secondary index" $+  withTestDb $ \conn -> do+    execute_ conn "create table idx_tbl (idx_value int not null primary key)"+    execute_ conn "create index idx_tbl_value on idx_tbl (idx_value)"+    let db :: CheckedDatabaseSettings Sqlite IdxDb+        db = defaultMigratableDbSettings `withDbModification`+              (dbModification @_ @Sqlite)+                { _idx_tbl =+                    addTableIndex "idx_tbl_value" (defaultIndexOptions @SqliteCommandSyntax)+                      (\t -> selectorColumnName _idx_value t NE.:| []) }+    testVerifySchema conn db++verifiesUniqueIndex :: TestTree+verifiesUniqueIndex = testCase "verifySchema correctly detects a UNIQUE secondary index" $+  withTestDb $ \conn -> do+    execute_ conn "create table idx_tbl (idx_value int not null primary key)"+    execute_ conn "create unique index idx_tbl_value_uniq on idx_tbl (idx_value)"+    let db :: CheckedDatabaseSettings Sqlite IdxDb+        db = defaultMigratableDbSettings `withDbModification`+              (dbModification @_ @Sqlite)+                { _idx_tbl =+                    let idxOpts = setUniqueIndexOptions @SqliteCommandSyntax True+                                $ defaultIndexOptions @SqliteCommandSyntax+                    in+                    addTableIndex "idx_tbl_value_uniq" idxOpts+                      (\t -> selectorColumnName _idx_value t NE.:| []) }+    testVerifySchema conn db