beam-sqlite 0.5.1.0 → 0.5.1.1

raw patch · 6 files changed

+152/−64 lines, 6 filesdep ~attoparsecdep ~bytestringdep ~dlistPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: attoparsec, bytestring, dlist, hashable, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−0
• Database/Beam/Sqlite/Syntax.hs +13/−1
• beam-sqlite.cabal +7/−6
• test/Database/Beam/Sqlite/Test/Insert.hs +118/−0
• test/Database/Beam/Sqlite/Test/Select.hs +2/−57
• test/Main.hs +2/−0

@@ -1,3 +1,13 @@+# 0.5.1.1++## Added features++ * GHC 9.2 and 9.0 support++## Bug fixes++ * Support inserting default values for all columns (except with upsert)+ # 0.5.1.0  ## Added features

@@ -94,6 +94,7 @@ -- value list is ignored. data SqliteSyntax = SqliteSyntax ((SQLData -> Builder) -> Builder) (DL.DList SQLData) newtype SqliteData = SqliteData SQLData -- newtype for Hashable+  deriving Eq  instance Show SqliteSyntax where   show (SqliteSyntax s d) =@@ -311,10 +312,21 @@ formatSqliteInsertOnConflict tblNm fields values onConflict = mconcat   [ emit "INSERT INTO "   , fromSqliteTableName tblNm-  , parens (commas (map quotedIdentifier fields))+  , if null fields+      then mempty+      else parens (commas (map quotedIdentifier fields))   , emit " "   , case values of       SqliteInsertFromSql (SqliteSelectSyntax select) -> select+      -- Because SQLite doesn't support explicit DEFAULT values, if an insert+      -- batch contains any defaults, we split it into a series of single-row+      -- inserts specifying only the non-default columns (which could differ+      -- between rows in the batch). To insert all default values, there is+      -- special DEFAULT VALUES syntax, which only supports one row anyway.+      -- Unfortunately, SQLite doesn't currently support DEFAULT VALUES with ON+      -- CONFLICT. We don't specially catch that in hopes that SQLite will some+      -- day support it, since there is really no reason it shouldn't.+      SqliteInsertExpressions [[]] -> emit "DEFAULT VALUES"       SqliteInsertExpressions es ->         emit "VALUES " <> commas (map (\row -> parens (commas (map fromSqliteExpression row)) ) es)   , maybe mempty ((emit " " <>) . fromSqliteOnConflict) onConflict

@@ -1,5 +1,5 @@ name:                beam-sqlite-version:             0.5.1.0+version:             0.5.1.1 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>@@ -30,17 +30,17 @@                        sqlite-simple >=0.4  && <0.5,                       text          >=1.0  && <1.3,-                      bytestring    >=0.10 && <0.11,-                      hashable      >=1.2  && <1.4,-                      time          >=1.6  && <1.10,-                      dlist         >=0.8  && <0.9,+                      bytestring    >=0.10 && <0.12,+                      hashable      >=1.2  && <1.5,+                      time          >=1.6  && <1.12,+                      dlist         >=0.8  && <1.1,                       mtl           >=2.1  && <2.3,                       free          >=4.12 && <5.2,                       scientific    >=0.3  && <0.4,                       monad-control        >=1.0  && <1.1,                       network-uri   >=2.6  && <2.7,                       aeson         >=0.11 && <1.6,-                      attoparsec    >=0.13 && <0.14,+                      attoparsec    >=0.13 && <0.15,                       transformers-base    >=0.4  && <0.5   default-language:   Haskell2010   default-extensions: ScopedTypeVariables, OverloadedStrings, MultiParamTypeClasses, RankNTypes, FlexibleInstances,@@ -74,6 +74,7 @@     time   other-modules:     Database.Beam.Sqlite.Test+    Database.Beam.Sqlite.Test.Insert     Database.Beam.Sqlite.Test.Migrate     Database.Beam.Sqlite.Test.Select   default-language: Haskell2010

@@ -0,0 +1,118 @@+module Database.Beam.Sqlite.Test.Insert (tests) where++import Data.Int (Int32)+import Data.Text (Text)+import Data.Time (LocalTime)+import Database.Beam+import Database.Beam.Backend.SQL.BeamExtensions+import Database.Beam.Sqlite hiding (runInsertReturningList)+import Database.SQLite.Simple (execute_)+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit++import Database.Beam.Sqlite.Test++tests :: TestTree+tests = testGroup "Insertion tests"+  [ testInsertReturningColumnOrder+  , testInsertOnlyDefaults+  , expectFail testUpsertOnlyDefaults+  ]++data TestTableT f+  = TestTable+  { ttId :: C f Int32+  , ttFirstName :: C f Text+  , ttLastName  :: C f Text+  , ttAge       :: C f Int32+  , ttDateJoined :: C f LocalTime+  } deriving (Generic, Beamable)++deriving instance Show (TestTableT Identity)+deriving instance Eq (TestTableT Identity)++instance Table TestTableT where+  data PrimaryKey TestTableT f = TestTableKey (C f Int32)+    deriving (Generic, Beamable)+  primaryKey = TestTableKey <$> ttId++data TestTableDb entity+  = TestTableDb+  { dbTestTable :: entity (TableEntity TestTableT)+  } deriving (Generic, Database Sqlite)++testDatabase :: DatabaseSettings be TestTableDb+testDatabase = defaultDbSettings++testInsertReturningColumnOrder :: TestTree+testInsertReturningColumnOrder = testCase "runInsertReturningList with mismatching column order" $ do+  withTestDb $ \conn -> do+    execute_ conn "CREATE TABLE test_table ( date_joined TIMESTAMP NOT NULL, first_name TEXT NOT NULL, id INT PRIMARY KEY, age INT NOT NULL, last_name TEXT NOT NULL )"+    inserted <-+      runBeamSqlite conn $ runInsertReturningList $+      insert (dbTestTable testDatabase) $+      insertExpressions [ TestTable 0 (concat_ [ "j", "im" ]) "smith" 19 currentTimestamp_+                        , TestTable 1 "sally" "apple" ((val_ 56 + val_ 109) `div_` 5) currentTimestamp_+                        , TestTable 4 "blah" "blah" (-1) currentTimestamp_ ]++    let dateJoined = ttDateJoined (head inserted)++        expected = [ TestTable 0 "jim" "smith" 19 dateJoined+                   , TestTable 1 "sally" "apple" 33 dateJoined+                   , TestTable 4 "blah" "blah" (-1) dateJoined ]++    assertEqual "insert values" inserted expected++data WithDefaultsT f = WithDefaults+  { _id :: C f (SqlSerial Int32)+  , _value :: C f Text+  } deriving (Generic, Beamable)++deriving instance Show (WithDefaultsT Identity)+deriving instance Eq (WithDefaultsT Identity)++instance Table WithDefaultsT where+  data PrimaryKey WithDefaultsT f = WithDefaultsKey (C f (SqlSerial Int32))+    deriving (Generic, Beamable)+  primaryKey = WithDefaultsKey <$> _id++data WithDefaultsDb entity = WithDefaultsDb+  { tblWithDefaults :: entity (TableEntity WithDefaultsT)+  } deriving (Generic, Database Sqlite)++withDefaultsDb :: DatabaseSettings be WithDefaultsDb+withDefaultsDb = defaultDbSettings++-- | Regression test for <https://github.com/haskell-beam/beam/issues/607 #607>+testInsertOnlyDefaults :: TestTree+testInsertOnlyDefaults = testCase "insert only default values" $+  withTestDb $ \conn -> do+    execute_ conn "CREATE TABLE with_defaults (id INTEGER PRIMARY KEY, value TEXT NOT NULL DEFAULT \"unknown\")"+    inserted <- runBeamSqlite conn $ runInsertReturningList $+      insert (tblWithDefaults withDefaultsDb) $ insertExpressions+        [ WithDefaults default_ default_+        , WithDefaults default_ $ val_ "other"+        ]+    assertEqual "inserted values" inserted+      [ WithDefaults 1 "unknown"+      , WithDefaults 2 "other"+      ]++testUpsertOnlyDefaults :: TestTree+testUpsertOnlyDefaults = testCase "upsert only default values" $+  withTestDb $ \conn -> do+    execute_ conn "CREATE TABLE with_defaults (id INTEGER PRIMARY KEY, value TEXT NOT NULL DEFAULT \"unknown\")"+    inserted <- runBeamSqlite conn $ runInsertReturningList $+      insertOnConflict (tblWithDefaults withDefaultsDb)+        ( insertExpressions+            [ WithDefaults default_ default_+            , WithDefaults default_ $ val_ "other"+            ]+        )+        anyConflict+        onConflictDoNothing+    assertEqual "inserted values" inserted+      [ WithDefaults 1 "unknown"+      , WithDefaults 2 "other"+      ]

@@ -1,28 +1,17 @@-{-# LANGUAGE OverloadedStrings #-}- module Database.Beam.Sqlite.Test.Select (tests) where -import Control.Exception+import Database.Beam+import Database.Beam.Sqlite import Test.Tasty import Test.Tasty.ExpectedFailure import Test.Tasty.HUnit -import Data.Int (Int32)-import Data.Text (Text)-import Data.Time (LocalTime)--import Database.Beam-import Database.Beam.Sqlite- import Database.Beam.Sqlite.Test -import Database.SQLite.Simple (execute_)- tests :: TestTree tests = testGroup "Selection tests"   [ expectFail testExceptValues   , testInRowValues-  , testInsertReturningColumnOrder -- In select tests because the bug was with the selects   ]  data Pair f = Pair@@ -46,47 +35,3 @@     result <- runBeamSqlite conn $ runSelectReturningList $ select $       values_ [as_ @Bool $ val_ True, val_ False] `except_` values_ [val_ False]     assertEqual "result" [True] result--data TestTableT f-  = TestTable-  { ttId :: C f Int32-  , ttFirstName :: C f Text-  , ttLastName  :: C f Text-  , ttAge       :: C f Int32-  , ttDateJoined :: C f LocalTime-  } deriving (Generic, Beamable)--deriving instance Show (TestTableT Identity)-deriving instance Eq (TestTableT Identity)--instance Table TestTableT where-  data PrimaryKey TestTableT f = TestTableKey (C f Int32)-    deriving (Generic, Beamable)-  primaryKey = TestTableKey <$> ttId--data TestTableDb entity-  = TestTableDb-  { dbTestTable :: entity (TableEntity TestTableT)-  } deriving (Generic, Database Sqlite)--testDatabase :: DatabaseSettings be TestTableDb-testDatabase = defaultDbSettings--testInsertReturningColumnOrder :: TestTree-testInsertReturningColumnOrder = testCase "runInsertReturningList with mismatching column order" $ do-  withTestDb $ \conn -> do-    execute_ conn "CREATE TABLE test_table ( date_joined TIMESTAMP NOT NULL, first_name TEXT NOT NULL, id INT PRIMARY KEY, age INT NOT NULL, last_name TEXT NOT NULL )"-    inserted <--      runBeamSqlite conn $ runInsertReturningList $-      insert (dbTestTable testDatabase) $-      insertExpressions [ TestTable 0 (concat_ [ "j", "im" ]) "smith" 19 currentTimestamp_-                        , TestTable 1 "sally" "apple" ((val_ 56 + val_ 109) `div_` 5) currentTimestamp_-                        , TestTable 4 "blah" "blah" (-1) currentTimestamp_ ]--    let dateJoined = ttDateJoined (head inserted)--        expected = [ TestTable 0 "jim" "smith" 19 dateJoined-                   , TestTable 1 "sally" "apple" 33 dateJoined-                   , TestTable 4 "blah" "blah" (-1) dateJoined ]--    assertEqual "insert values" inserted expected

@@ -3,10 +3,12 @@ import Test.Tasty  import qualified Database.Beam.Sqlite.Test.Migrate as Migrate+import qualified Database.Beam.Sqlite.Test.Insert as Insert import qualified Database.Beam.Sqlite.Test.Select as Select  main :: IO () main = defaultMain $ testGroup "beam-sqlite tests"   [ Migrate.tests   , Select.tests+  , Insert.tests   ]