circuithub
Dealing with GENERATED ALWAYS columns?
I've got a column in my database that is created via:
ALTER TABLE discovery
ADD COLUMN search tsvector
GENERATED ALWAYS AS ...
which I'd like to be able to query on. I've thus added it to my rel8 schema:
data Tsvector = Tsvector
deriving (Eq, Ord, Show)
instance DBEq Tsvector
instance DBOrd Tsvector
instance DBType Tsvector where
typeInformation = TypeInformation
{ encode = const $ Prim.ConstExpr $ Prim.DefaultLit
, decode = Decode.custom $ \_ _ -> pure Tsvector
, typeName = "tsvector"
}
data Discovery f = Discovery
{ d_docId :: Column f DocId
, d_search :: Column f Tsvector
}
deriving stock Generic
deriving anyclass Rel8able
There are two problems with this:
- When working with UPDATE statements, rel8 generates SQL like:
UPDATE discovery SET ..., search = search;
which postgres complains about; this must have value DEFAULT. I can use unsafeDefault to fill this in successfully (but it's a bit annoying!)
- When working with INSERT statements, rel8 generates SQL like:
INSERT INTO discovery VALUES (...., CAST(DEFAULT as tsvector));
which also fails (DEFAULT is not allowed in this context), however, I can't figure out how to sidestep this problem; rel8 seems to insist on an explicit cast in inserts.
Is there a better way of working with GENERATED ALWAYS columns? I'd like to be able to select this field, but have it ignored from all updates and inserts.
I came up with a surprisingly nice workaround here:
data Discovery f = Discovery
{ d_docId :: Column f DocId
}
deriving stock Generic
deriving anyclass Rel8able
data Discovery' f = Discovery'
{ d_table :: Discovery f
, d_search :: Column f Tsvector
}
deriving stock Generic
deriving anyclass Rel8able
discoverySchema :: TableSchema (Discovery Name)
discoverySchema = TableSchema
{ name = "discovery"
, schema = Just "public"
, columns = Discovery
{ d_docId = "doc_id"
}
}
discoverySchema' :: TableSchema (Discovery' Name)
discoverySchema' = discoverySchema
{ columns = Discovery'
{ d_table = columns discoverySchema
, d_search = "search"
}
}
rel8 is impressively smart enough to do the right thing for nested tables like this! kudos to you all for such an amazing library!
Is the problem with unsafeDefault maybe a regression? #121 claims to have fixed the "DEFAULT is not allowed in this context" thing, but it looks like something changed since then. This pattern match in Rel8.Statement.Select:
ppRows :: Table Expr a => Query a -> Doc
ppRows query = case optimize primQuery of
-- Special case VALUES because we can't use DEFAULT inside a SELECT
Optimized (Opaleye.Product ((_, Opaleye.Values symbols rows) :| []) [])
| eqSymbols symbols (toList (T.exprs a)) ->
Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)
_ -> ppSelect query
Seems to be going into the "_" branch. I think it needs to be something like this now:
ppRows :: Table Expr a => Query a -> Doc
ppRows query = case optimize primQuery of
-- Special case VALUES because we can't use DEFAULT inside a SELECT
Optimized (Opaleye.Values symbols rows)
| eqSymbols symbols (toList (T.exprs a)) ->
Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)
_ -> ppSelect query
Making that change allows my insert statements with defaults to work. Not sure if that is actually correct; don't understand Opaleye's datatypes.
I have a testcase for this, but I'm having trouble getting the temporary postgres database to work. In the mean time, I have the unittest all hacked up to connect to an actual postgres database.
[nix-shell:~/rel8]$ cabal test
Resolving dependencies...
Build profile: -w ghc-9.2.4 -O1
In order, the following will be built (use -v for more details):
- rel8-1.4.0.0 (test:tests) (first run)
Preprocessing test suite 'tests' for rel8-1.4.0.0..
Building test suite 'tests' for rel8-1.4.0.0..
Running 1 test suites...
Test suite tests: RUNNING...
rel8
Can SELECT TestTable: FAIL
Exception: InitDbFailed {startErrorStdOut = "The files belonging to this database system will be owned by user \"peter\".This user must also own the server process.", startErrorStdErr = "", startErrorExitCode = ExitFailure 1}
Use -p '/Can SELECT TestTable/' to rerun this test only.
Set up test table:
peter@gtower:~/rel8$ psql
psql (12.12 (Ubuntu 12.12-0ubuntu0.20.04.1))
Type "help" for help.
peter=> create table test_table (column1 text default 'apples', column2 bool default false);
CREATE TABLE
This test fails on master (1); passes with the change to the pattern match (2); and fails I change "apples" to "oranges" (3).
testDefaultValues :: IO () -> TestTree
testDefaultValues = databasePropertyTest' "can insert default values" \transaction -> do
--rows <- forAll $ Gen.map (Range.linear 0 5) $ liftA2 (,) genTestTable genTestTable
transaction do
selected <- lift do
statement () $ Rel8.insert Rel8.Insert
{ into = testTableSchema
, rows = Rel8.values [ TestTable { testTableColumn1 = Rel8.unsafeDefault, testTableColumn2 = Rel8.unsafeDefault }]
, onConflict = Rel8.DoNothing
, returning = pure ()
}
statement () $ Rel8.select do
Rel8.each testTableSchema
sort selected === sort ([TestTable { testTableColumn1 = "apples", testTableColumn2 = False}])
-- cover 1 "Empty" $ null rows
-- cover 1 "Singleton" $ null $ drop 1 $ Map.keys rows
-- cover 1 ">1 row" $ not $ null $ drop 1 $ Map.keys rows
return ()
1:
Linking /home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/build/tests/tests ...
Running 1 test suites...
Test suite tests: RUNNING...
can insert default values: FAIL
✗ <interactive> failed at tests/Main.hs:926:27
after 1 test.
┏━━ tests/Main.hs ━━━
920 ┃ databasePropertyTest'
921 ┃ :: TestName
922 ┃ -> ((TestT Transaction () -> PropertyT IO ()) -> PropertyT IO ())
923 ┃ -> IO () -> TestTree
924 ┃ databasePropertyTest' testName f _getTestDatabase =
925 ┃ withResource (acquire "xxx" >>= either (maybe empty (fail . unpack . decodeUtf8)) pure) release $ \c ->
926 ┃ testProperty testName $ property do
927 ┃ connection <- lift c
928 ┃ f $ test . hoist \m -> do
929 ┃ e <- run (Hasql.transaction Hasql.Serializable Hasql.Write (m <* condemn)) connection
930 ┃ either throwIO pure e
┃ ^^^^^^^^^^^^^^^^^^^^^
┃ │ ━━━ Exception (QueryError) ━━━
┃ │ QueryError "INSERT INTO \"test_table\" (\"column1\",\n \"column2\")\nSELECT\nCAST(\"values_1\" AS text) as \"testTableColumn1\",\nCAST(\"values_2\" AS bool) as \"testTableColumn2\"\nFROM (SELECT \"column1\" as \"values_1\",\n \"column2\" as \"values_2\"\n FROM\n (VALUES\n (DEFAULT,DEFAULT)) as \"V\") as \"T1\"\nON CONFLICT DO NOTHING" [] (ResultError (ServerError "42601" "DEFAULT is not allowed in this context" Nothing Nothing (Just 285)))
This failure can be reproduced by running:
> recheck (Size 0) (Seed 14096366136193415544 13383493698543857611) <property>
Use '--pattern "$NF ~ /can insert default values/" --hedgehog-replay "Size 0 Seed 14096366136193415544 13383493698543857611"' to reproduce from the command-line.
1 out of 1 tests failed (0.02s)
Test suite tests: FAIL
Test suite logged to:
/home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/test/rel8-1.4.0.0-tests.log
0 of 1 test suites (0 of 1 test cases) passed.
Error: cabal: Tests failed for test:tests from rel8-1.4.0.0.
2:
Linking /home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/build/tests/tests ...
Running 1 test suites...
Test suite tests: RUNNING...
Test suite tests: PASS
Test suite logged to:
/home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/test/rel8-1.4.0.0-tests.log
1 of 1 test suites (1 of 1 test cases) passed.
3:
Linking /home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/build/tests/tests ...
Running 1 test suites...
Test suite tests: RUNNING...
can insert default values: FAIL
✗ <interactive> failed at tests/Main.hs:912:5
after 1 test.
┏━━ tests/Main.hs ━━━
896 ┃ testDefaultValues :: IO () -> TestTree
897 ┃ testDefaultValues = databasePropertyTest' "can insert default values" \transaction -> do
898 ┃ --rows <- forAll $ Gen.map (Range.linear 0 5) $ liftA2 (,) genTestTable genTestTable
899 ┃
900 ┃ transaction do
901 ┃ selected <- lift do
902 ┃ statement () $ Rel8.insert Rel8.Insert
903 ┃ { into = testTableSchema
904 ┃ , rows = Rel8.values [ TestTable { testTableColumn1 = Rel8.unsafeDefault, testTableColumn2 = Rel8.unsafeDefault }]
905 ┃ , onConflict = Rel8.DoNothing
906 ┃ , returning = pure ()
907 ┃ }
908 ┃
909 ┃ statement () $ Rel8.select do
910 ┃ Rel8.each testTableSchema
911 ┃
912 ┃ sort selected === sort ([TestTable { testTableColumn1 = "oranges", testTableColumn2 = False}])
┃ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
┃ │ ━━━ Failed (- lhs) (+ rhs) ━━━
┃ │ [
┃ │ TestTable {
┃ │ testTableColumn1 =
┃ │ - "apples"
┃ │ + "oranges"
┃ │ , testTableColumn2 =
┃ │ False
┃ │ }
┃ │ ]
913 ┃
914 ┃ -- cover 1 "Empty" $ null rows
915 ┃ -- cover 1 "Singleton" $ null $ drop 1 $ Map.keys rows
916 ┃ -- cover 1 ">1 row" $ not $ null $ drop 1 $ Map.keys rows
917 ┃
918 ┃ return ()
This failure can be reproduced by running:
> recheck (Size 0) (Seed 5067174663986397603 5596507757282192057) <property>
Use '--pattern "$NF ~ /can insert default values/" --hedgehog-replay "Size 0 Seed 5067174663986397603 5596507757282192057"' to reproduce from the command-line.
1 out of 1 tests failed (0.02s)
Test suite tests: FAIL
Test suite logged to:
/home/peter/rel8/dist-newstyle/build/x86_64-linux/ghc-8.10.7/rel8-1.4.0.0/t/tests/test/rel8-1.4.0.0-tests.log
0 of 1 test suites (0 of 1 test cases) passed.
Error: cabal: Tests failed for test:tests from rel8-1.4.0.0.
(Note the signature of that test is different than the other tests because of the aforementioned hacks.)
databasePropertyTest'
:: TestName
-> ((TestT Transaction () -> PropertyT IO ()) -> PropertyT IO ())
-> IO () -> TestTree
databasePropertyTest' testName f _getTestDatabase =
withResource (acquire "XXX" >>= either (maybe empty (fail . unpack . decodeUtf8)) pure) release $ \c ->
testProperty testName $ property do
connection <- lift c
f $ test . hoist \m -> do
e <- run (Hasql.transaction Hasql.Serializable Hasql.Write (m <* condemn)) connection
either throwIO pure e
Hi @peterwicksstringfield - I believe this is a recent regression in main that I think @shane-circuithub is aware of. The last published release shouldn't have this problem though
When working with UPDATE statements, [...] I can use unsafeDefault to fill this in successfully (but it's a bit annoying!)
This doesn't work if the unsafeDefault is going into a column that is a foreign key target referenced by some table: Postgres will complain that updating it to DEFAULT would violate referential integrity.
I wonder if there's a way to change updates to use a type family context in set :: _ -> _ -> Foo context that wraps each constructor in a Maybe and omits the SETs for the Nothing cases.