Dealing with GENERATED ALWAYS columns?

[isovector]

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]

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]

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    

[ocharles]

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]

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]

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.