search

circuithub / rel8

Hey! Hey! Can u rel8?
https://rel8.readthedocs.io
Other
150 stars 38 forks source link

Dealing with GENERATED ALWAYS columns? #193

Open isovector opened 1 year ago

isovector commented 1 year ago

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:

1) 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!)

2) 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.

isovector commented 1 year ago

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!

peterwicksstringfield commented 1 year ago

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.

```shell [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:

```haskell 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 ✗ 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) 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:

```haskell 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:

```haskell 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 ✗ 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) 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.)

```haskell 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 ```
ocharles commented 1 year ago

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

evertedsphere commented 1 month ago

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.

evertedsphere commented 1 month ago

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.