rel8 1.1.0.0 → 1.2.0.0
raw patch · 17 files changed
+216/−103 lines, 17 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Rel8: ($*) :: Projecting a (Expr b) => Projection a (Expr b) -> ListTable Expr a -> Expr [b]
+ Rel8: ($+) :: Projecting a (Expr b) => Projection a (Expr b) -> NonEmptyTable Expr a -> Expr (NonEmpty b)
- Rel8: infixl 4 $?
+ Rel8: infixl 4 $+
- Rel8: rebind :: Table Expr a => a -> Query a
+ Rel8: rebind :: Table Expr a => String -> a -> Query a
Files
- Changelog.md +18/−0
- rel8.cabal +2/−1
- src/Rel8.hs +3/−2
- src/Rel8/Aggregate.hs +8/−24
- src/Rel8/Aggregate.hs-boot +0/−11
- src/Rel8/Query/Evaluate.hs +3/−22
- src/Rel8/Query/List.hs +9/−7
- src/Rel8/Query/Rebind.hs +35/−0
- src/Rel8/Schema/Context/Nullify.hs +6/−14
- src/Rel8/Schema/HTable/Vectorize.hs +8/−1
- src/Rel8/Schema/Name.hs-boot +0/−11
- src/Rel8/Table/List.hs +14/−3
- src/Rel8/Table/NonEmpty.hs +14/−3
- src/Rel8/Table/Projection.hs +1/−1
- src/Rel8/Tabulate.hs +1/−1
- src/Rel8/Type/Ord.hs +0/−2
- tests/Main.hs +94/−0
Changelog.md view
@@ -1,3 +1,21 @@+# 1.2.0.0 (2021-10-22)++## New features++* New `$*` and `$+` operators for projecting out of `ListTable` and `NonEmptyTable` respectively (analogous to the existing `$?` for `MaybeTable`). ([#125](https://github.com/circuithub/rel8/pull/125))++## Bug fixes++* Fix `UPSERT` support (and add tests), which was broken due to a typo inside Rel8 that made it impossible to construct `Projection`s which are needed by `UPSERT`. ([#134](https://github.com/circuithub/rel8/pull/134))++* Remove `DBMin` and `DBMax` instances for `Bool`, which are invalid as far as Postgres is concerned. `and` and `or` can be used to achieve the same thing. ([#126](https://github.com/circuithub/rel8/pull/126))++* Fix `aggregateMaybeTable`, `aggregateEitherTable` and `aggregateTheseTable`, which generated invalid SQL previously. ([#127](https://github.com/circuithub/rel8/pull/127))++## Breaking changes++* `rebind` now takes an additional argument for the "name" of the binding. ([#128](https://github.com/circuithub/rel8/pull/128))+ # 1.1.0.0 (2021-07-16) ## New features
rel8.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: rel8-version: 1.1.0.0+version: 1.2.0.0 synopsis: Hey! Hey! Can u rel8? license: BSD3 license-file: LICENSE@@ -113,6 +113,7 @@ Rel8.Query.Null Rel8.Query.Opaleye Rel8.Query.Order+ Rel8.Query.Rebind Rel8.Query.Set Rel8.Query.SQL Rel8.Query.These
src/Rel8.hs view
@@ -90,7 +90,7 @@ -- ** @ListTable@ , ListTable- , listTable+ , listTable, ($*) , nameListTable , many , manyExpr@@ -99,7 +99,7 @@ -- ** @NonEmptyTable@ , NonEmptyTable- , nonEmptyTable+ , nonEmptyTable, ($+) , nameNonEmptyTable , some , someExpr@@ -331,6 +331,7 @@ import Rel8.Query.Maybe import Rel8.Query.Null import Rel8.Query.Order+import Rel8.Query.Rebind import Rel8.Query.SQL (showQuery) import Rel8.Query.Set import Rel8.Query.These
src/Rel8/Aggregate.hs view
@@ -9,14 +9,14 @@ {-# language UndecidableInstances #-} module Rel8.Aggregate- ( Aggregate(..), foldInputs, mapInputs+ ( Aggregate(..), zipOutputs , Aggregator(..), unsafeMakeAggregate , Aggregates ) where -- base-import Data.Functor.Const ( Const( Const ), getConst )+import Control.Applicative ( liftA2 ) import Data.Functor.Identity ( Identity( Identity ) ) import Data.Kind ( Constraint, Type ) import Prelude@@ -40,11 +40,7 @@ import Rel8.Type ( DBType ) --- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can--- unpack an @Aggregate@ back to @a@ by running it with 'Rel8.aggregate'. As--- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'--- operation. This means 'Aggregate' is an instance of 'Apply', and you can--- combine @Aggregate@s using the @<.>@ combinator.+-- | 'Aggregate' is a special context used by 'Rel8.aggregate'. type Aggregate :: K.Context newtype Aggregate a = Aggregate (Opaleye.Aggregator () (Expr a)) @@ -61,28 +57,16 @@ fromResult (HIdentity (Identity a)) = a --- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's--- for the columns in @b@.+-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate's+-- for the 'Expr' columns in @b@. type Aggregates :: Type -> Type -> Constraint class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs -foldInputs :: forall (a :: Type) (b :: Type). Monoid b- => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b-foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =- getConst $ flip agg () $ \(aggregator, a) ->- Const $ f (detuplize <$> aggregator) a- where- detuplize (operation, ordering, distinction) =- Aggregator {operation, ordering, distinction}---mapInputs :: forall (a :: Type). ()- => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a-mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =- Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->- f (fmap transform input)+zipOutputs :: ()+ => (Expr a -> Expr b -> Expr c) -> Aggregate a -> Aggregate b -> Aggregate c+zipOutputs f (Aggregate a) (Aggregate b) = Aggregate (liftA2 f a b) type Aggregator :: Type
− src/Rel8/Aggregate.hs-boot
@@ -1,11 +0,0 @@-{-# language PolyKinds #-}-{-# language RoleAnnotations #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Aggregate where--import Data.Kind--type Aggregate :: k -> Type-type role Aggregate nominal-data Aggregate a
src/Rel8/Query/Evaluate.hs view
@@ -3,7 +3,6 @@ module Rel8.Query.Evaluate ( evaluate- , rebind ) where @@ -16,28 +15,23 @@ -- opaleye import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye-import qualified Opaleye.Internal.PackMap as Opaleye-import qualified Opaleye.Internal.PrimQuery as Opaleye-import qualified Opaleye.Internal.QueryArr as Opaleye-import qualified Opaleye.Internal.Tag as Opaleye-import qualified Opaleye.Internal.Unpackspec as Opaleye -- rel8 import Rel8.Expr ( Expr ) import Rel8.Expr.Bool ( (&&.) ) import Rel8.Expr.Opaleye ( fromPrimExpr ) import Rel8.Query ( Query( Query ) )+import Rel8.Query.Rebind ( rebind ) import Rel8.Table ( Table ) import Rel8.Table.Bool ( case_ )-import Rel8.Table.Opaleye ( unpackspec )-import Rel8.Table.Undefined+import Rel8.Table.Undefined ( undefined ) -- | 'evaluate' takes expressions that could potentially have side effects and -- \"runs\" them in the 'Query' monad. The returned expressions have no side -- effects and can safely be reused. evaluate :: Table Expr a => a -> Query a-evaluate = laterally >=> rebind+evaluate = laterally >=> rebind "eval" laterally :: Table Expr a => a -> Query a@@ -49,19 +43,6 @@ condition = foldl1' (&&.) (fmap go bindings') where go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull----- | 'rebind' takes some expressions, and binds each of them to a new--- variable in the SQL. The @a@ returned consists only of these--- variables. It's essentially a @let@ binding for Postgres expressions.-rebind :: Table Expr a => a -> Query a-rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->- let- tag' = Opaleye.next tag- (a', bindings) = Opaleye.run $- Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag) a- in- ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag') foldl1' :: (a -> a -> a) -> NonEmpty a -> a
src/Rel8/Query/List.hs view
@@ -24,8 +24,8 @@ import Rel8.Expr.Opaleye ( mapPrimExpr ) import Rel8.Query ( Query ) import Rel8.Query.Aggregate ( aggregate )-import Rel8.Query.Evaluate ( rebind ) import Rel8.Query.Maybe ( optional )+import Rel8.Query.Rebind ( rebind ) import Rel8.Schema.HTable.Vectorize ( hunvectorize ) import Rel8.Schema.Null ( Sql, Unnullify ) import Rel8.Schema.Spec ( Spec( Spec, info ) )@@ -85,8 +85,9 @@ -- -- @catListTable@ is an inverse to 'many'. catListTable :: Table Expr a => ListTable Expr a -> Query a-catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $- hunvectorize (\Spec {info} -> pure . sunnest info) as+catListTable (ListTable as) =+ rebind "unnest" $ fromColumns $ runIdentity $+ hunvectorize (\Spec {info} -> pure . sunnest info) as -- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an@@ -94,8 +95,9 @@ -- -- @catNonEmptyTable@ is an inverse to 'some'. catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a-catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $- hunvectorize (\Spec {info} -> pure . sunnest info) as+catNonEmptyTable (NonEmptyTable as) =+ rebind "unnest" $ fromColumns $ runIdentity $+ hunvectorize (\Spec {info} -> pure . sunnest info) as -- | Expand an expression that contains a list into a 'Query', where each row@@ -103,7 +105,7 @@ -- -- @catList@ is an inverse to 'manyExpr'. catList :: Sql DBType a => Expr [a] -> Query (Expr a)-catList = rebind . sunnest typeInformation+catList = rebind "unnest" . sunnest typeInformation -- | Expand an expression that contains a non-empty list into a 'Query', where@@ -111,7 +113,7 @@ -- -- @catNonEmpty@ is an inverse to 'someExpr'. catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)-catNonEmpty = rebind . sunnest typeInformation+catNonEmpty = rebind "unnest" . sunnest typeInformation sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a
+ src/Rel8/Query/Rebind.hs view
@@ -0,0 +1,35 @@+{-# language FlexibleContexts #-}++module Rel8.Query.Rebind+ ( rebind+ )+where++-- base+import Prelude++-- opaleye+import qualified Opaleye.Internal.PackMap as Opaleye+import qualified Opaleye.Internal.PrimQuery as Opaleye+import qualified Opaleye.Internal.QueryArr as Opaleye+import qualified Opaleye.Internal.Tag as Opaleye+import qualified Opaleye.Internal.Unpackspec as Opaleye++-- rel8+import Rel8.Expr ( Expr )+import Rel8.Query ( Query( Query ) )+import Rel8.Table ( Table )+import Rel8.Table.Opaleye ( unpackspec )+++-- | 'rebind' takes a variable name, some expressions, and binds each of them+-- to a new variable in the SQL. The @a@ returned consists only of these+-- variables. It's essentially a @let@ binding for Postgres expressions.+rebind :: Table Expr a => String -> a -> Query a+rebind prefix a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->+ let+ tag' = Opaleye.next tag+ (a', bindings) = Opaleye.run $+ Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr prefix tag) a+ in+ ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')
src/Rel8/Schema/Context/Nullify.hs view
@@ -18,18 +18,17 @@ import Data.Bool ( bool ) import Data.Functor.Identity ( Identity( Identity ) ) import Data.Kind ( Constraint, Type )-import Data.Monoid ( getFirst ) import Prelude hiding ( null ) -- opaleye import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye -- rel8-import Rel8.Aggregate ( Aggregate( Aggregate ), foldInputs, mapInputs )+import Rel8.Aggregate ( Aggregate(..), zipOutputs ) import Rel8.Expr ( Expr ) import Rel8.Expr.Bool ( boolExpr ) import Rel8.Expr.Null ( nullify, unsafeUnnullify )-import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )+import Rel8.Expr.Opaleye ( fromPrimExpr ) import Rel8.Kind.Context ( SContext(..) ) import Rel8.Schema.Field ( Field ) import qualified Rel8.Schema.Kind as K@@ -95,17 +94,10 @@ -> context (Maybe a) -> context (Maybe a) guarder = \case- SAggregate -> \tag _ isNonNull (Aggregate a) ->- let- mtag = foldInputs (\_ -> pure . fromPrimExpr) tag- run = maybe id (sguard . isNonNull) (getFirst mtag)- in- mapInputs (toPrimExpr . run . fromPrimExpr) $- Aggregate $- run <$> a- SExpr -> \tag _ isNonNull a -> sguard (isNonNull tag) a- SField -> \_ _ _ field -> field- SName -> \_ _ _ name -> name+ SAggregate -> \tag _ isNonNull -> zipOutputs (sguard . isNonNull) tag+ SExpr -> \tag _ isNonNull -> sguard (isNonNull tag)+ SField -> \_ _ _ -> id+ SName -> \_ _ _ -> id SResult -> \(Identity tag) isNonNull _ (Identity a) -> Identity (bool Nothing a (isNonNull tag))
src/Rel8/Schema/HTable/Vectorize.hs view
@@ -22,6 +22,7 @@ , hvectorize, hunvectorize , happend, hempty , hproject+ , hcolumn ) where @@ -36,9 +37,11 @@ import Rel8.Schema.Dict ( Dict( Dict ) ) import qualified Rel8.Schema.Kind as K import Rel8.Schema.HTable ( HTable, hfield, htabulate, htabulateA, hspecs )+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) ) import Rel8.Schema.HTable.MapTable- ( HMapTable, HMapTableField( HMapTableField )+ ( HMapTable( HMapTable ), HMapTableField( HMapTableField ) , MapSpec, mapInfo+ , Precompose( Precompose ) ) import qualified Rel8.Schema.HTable.MapTable as HMapTable ( hproject ) import Rel8.Schema.Null ( Unnullify, NotNull, Nullity( NotNull ) )@@ -133,3 +136,7 @@ => (forall ctx. t ctx -> t' ctx) -> HVectorize list t context -> HVectorize list t' context hproject f (HVectorize a) = HVectorize (HMapTable.hproject f a)+++hcolumn :: HVectorize list (HIdentity a) context -> context (list a)+hcolumn (HVectorize (HMapTable (HIdentity (Precompose a)))) = a
− src/Rel8/Schema/Name.hs-boot
@@ -1,11 +0,0 @@-{-# language PolyKinds #-}-{-# language RoleAnnotations #-}-{-# language StandaloneKindSignatures #-}--module Rel8.Schema.Name where--import Data.Kind ( Type )--type Name :: k -> Type-type role Name nominal-data Name a
src/Rel8/Table/List.hs view
@@ -11,7 +11,9 @@ module Rel8.Table.List ( ListTable(..)- , listTable, nameListTable+ , ($*)+ , listTable+ , nameListTable ) where @@ -28,7 +30,7 @@ import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize , happend, hempty- , hproject+ , hproject, hcolumn ) import qualified Rel8.Schema.Kind as K import Rel8.Schema.Name ( Name( Name ) )@@ -46,7 +48,9 @@ ) import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.Ord ( OrdTable, ordTable )-import Rel8.Table.Projection ( Projectable, project, apply )+import Rel8.Table.Projection+ ( Projectable, Projecting, Projection, project, apply+ ) import Rel8.Table.Serialize ( ToExprs ) @@ -114,6 +118,13 @@ Monoid (ListTable context a) where mempty = ListTable $ hempty $ \Spec {info} -> sempty info+++-- | Project a single expression out of a 'ListTable'.+($*) :: Projecting a (Expr b)+ => Projection a (Expr b) -> ListTable Expr a -> Expr [b]+f $* ListTable a = hcolumn $ hproject (apply f) a+infixl 4 $* -- | Construct a @ListTable@ from a list of expressions.
src/Rel8/Table/NonEmpty.hs view
@@ -11,7 +11,9 @@ module Rel8.Table.NonEmpty ( NonEmptyTable(..)- , nonEmptyTable, nameNonEmptyTable+ , ($+)+ , nonEmptyTable+ , nameNonEmptyTable ) where @@ -29,7 +31,7 @@ import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize , happend- , hproject+ , hproject, hcolumn ) import qualified Rel8.Schema.Kind as K import Rel8.Schema.Name ( Name( Name ) )@@ -44,7 +46,9 @@ import Rel8.Table.Alternative ( AltTable, (<|>:) ) import Rel8.Table.Eq ( EqTable, eqTable ) import Rel8.Table.Ord ( OrdTable, ordTable )-import Rel8.Table.Projection ( Projectable, project, apply )+import Rel8.Table.Projection+ ( Projectable, Projecting, Projection, project, apply+ ) import Rel8.Table.Serialize ( ToExprs ) @@ -108,6 +112,13 @@ where NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $ happend (const sappend1) as bs+++-- | Project a single expression out of a 'NonEmptyTable'.+($+) :: Projecting a (Expr b)+ => Projection a (Expr b) -> NonEmptyTable Expr a -> Expr (NonEmpty b)+f $+ NonEmptyTable a = hcolumn $ hproject (apply f) a+infixl 4 $+ -- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
src/Rel8/Table/Projection.hs view
@@ -35,7 +35,7 @@ => Projecting a b instance ( Transposes (Context a) (Field a) a (Transpose (Field a) a)- , Transposes (Context a) (Field a) b (Transpose (Field b) b)+ , Transposes (Context a) (Field a) b (Transpose (Field a) b) ) => Projecting a b
src/Rel8/Tabulate.hs view
@@ -179,7 +179,7 @@ -- stopping a 'Tabulation' from containing multiple rows with the same key, so -- technically @Map k (NonEmpty a)@ is more accurate. ----- 'Tabulation's can be created from 'Query's with 'fromQuery' and 'littQuery'+-- 'Tabulation's can be created from 'Query's with 'fromQuery' and 'liftQuery' -- and converted back to 'Query's with 'lookup' and 'toQuery' (though note the -- caveats that come with the latter). type Tabulation :: Type -> Type -> Type
src/Rel8/Type/Ord.hs view
@@ -75,7 +75,6 @@ -- | The class of database types that support the @max@ aggregation function. type DBMax :: Type -> Constraint class DBOrd a => DBMax a-instance DBMax Bool instance DBMax Char instance DBMax Int16 instance DBMax Int32@@ -101,7 +100,6 @@ -- | The class of database types that support the @min@ aggregation function. type DBMin :: Type -> Constraint class DBOrd a => DBMin a-instance DBMin Bool instance DBMin Char instance DBMin Int16 instance DBMin Int32
tests/Main.hs view
@@ -1,3 +1,4 @@+{-# language BangPatterns #-} {-# language BlockArguments #-} {-# language DeriveAnyClass #-} {-# language DeriveGeneric #-}@@ -5,6 +6,7 @@ {-# language FlexibleContexts #-} {-# language FlexibleInstances #-} {-# language MonoLocalBinds #-}+{-# language NamedFieldPuns #-} {-# language OverloadedStrings #-} {-# language RecordWildCards #-} {-# language ScopedTypeVariables #-}@@ -36,6 +38,7 @@ import Data.CaseInsensitive ( mk ) -- containers+import Data.Containers.ListUtils ( nubOrdOn ) import qualified Data.Map.Strict as Map -- hasql@@ -113,11 +116,13 @@ , testCatMaybeTable getTestDatabase , testCatMaybe getTestDatabase , testMaybeTable getTestDatabase+ , testAggregateMaybeTable getTestDatabase , testNestedTables getTestDatabase , testMaybeTableApplicative getTestDatabase , testLogicalFixities getTestDatabase , testUpdate getTestDatabase , testDelete getTestDatabase+ , testUpsert getTestDatabase , testSelectNestedPairs getTestDatabase , testSelectArray getTestDatabase , testNestedMaybeTable getTestDatabase@@ -133,6 +138,7 @@ flip run conn do sql "CREATE EXTENSION citext" sql "CREATE TABLE test_table ( column1 text not null, column2 bool not null )"+ sql "CREATE TABLE unique_table ( \"key\" text not null unique, \"value\" text not null )" sql "CREATE SEQUENCE test_seq" return db@@ -555,6 +561,28 @@ _ -> sort selected === sort rows +testAggregateMaybeTable :: IO TmpPostgres.DB -> TestTree+testAggregateMaybeTable = databasePropertyTest "aggregateMaybeTable" \transaction -> evalM do+ rows <- forAll $ Gen.list (Range.linear 0 10) (Gen.maybe (Gen.int64 (Range.linear 0 10)))++ let+ aggregate = go 0 False False+ where+ go !n nothing _ (Just a : as) = go (n + a) nothing True as+ go n _ just (Nothing : as) = go n True just as+ go _ False False [] = []+ go _ True False [] = [Nothing]+ go n False True [] = [Just n]+ go n True True [] = [Nothing, Just n]++ transaction do+ selected <- lift do+ statement () $ Rel8.select do+ Rel8.aggregate $ Rel8.aggregateMaybeTable Rel8.sum <$> Rel8.values (Rel8.lit <$> rows)++ sort selected === aggregate rows++ data TwoTestTables f = TwoTestTables { testTable1 :: TestTable f@@ -683,6 +711,72 @@ pure (deleted, selected) sort (deleted <> selected) === sort rows+++data UniqueTable f = UniqueTable+ { uniqueTableKey :: Rel8.Column f Text+ , uniqueTableValue :: Rel8.Column f Text+ }+ deriving stock Generic+ deriving anyclass Rel8.Rel8able+++deriving stock instance Eq (UniqueTable Result)+deriving stock instance Ord (UniqueTable Result)+deriving stock instance Show (UniqueTable Result)+++uniqueTableSchema :: Rel8.TableSchema (UniqueTable Rel8.Name)+uniqueTableSchema =+ Rel8.TableSchema+ { name = "unique_table"+ , schema = Nothing+ , columns = UniqueTable+ { uniqueTableKey = "key"+ , uniqueTableValue = "value"+ }+ }+++genUniqueTable :: Gen (UniqueTable Result)+genUniqueTable = do+ uniqueTableKey <- Gen.text (Range.linear 0 5) Gen.alphaNum+ uniqueTableValue <- Gen.text (Range.linear 0 5) Gen.alphaNum+ pure UniqueTable {..}+++testUpsert :: IO TmpPostgres.DB -> TestTree+testUpsert = databasePropertyTest "Can UPSERT UniqueTable" \transaction -> do+ as <- unique $ forAll $ Gen.list (Range.linear 0 20) genUniqueTable+ bs <- unique $ forAll $ Gen.list (Range.linear 0 20) genUniqueTable++ transaction do+ selected <- lift do+ statement () $ Rel8.insert Rel8.Insert+ { into = uniqueTableSchema+ , rows = Rel8.values $ Rel8.lit <$> as+ , onConflict = Rel8.DoNothing+ , returning = pure ()+ }++ statement () $ Rel8.insert Rel8.Insert+ { into = uniqueTableSchema+ , rows = Rel8.values $ Rel8.lit <$> bs+ , onConflict = Rel8.DoUpdate Rel8.Upsert+ { index = uniqueTableKey+ , set = \UniqueTable {uniqueTableValue} old -> old {uniqueTableValue}+ , updateWhere = \_ _ -> Rel8.true+ }+ , returning = pure ()+ }++ statement () $ Rel8.select do+ Rel8.each uniqueTableSchema++ fromUniqueTables selected === fromUniqueTables bs <> fromUniqueTables as+ where+ unique = fmap (nubOrdOn uniqueTableKey)+ fromUniqueTables = Map.fromList . map \(UniqueTable key value) -> (key, value) newtype HKNestedPair f = HKNestedPair { pairOne :: (TestTable f, TestTable f) }