beam-core 0.7.2.3 → 0.8.0.0

raw patch · 33 files changed

+2848/−1781 lines, 33 filesdep +scientificdep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific, vector

API changes (from Hackage documentation)

Files

• ChangeLog.md +83/−0
• Database/Beam.hs +1/−3
• Database/Beam/Backend.hs +2/−1
• Database/Beam/Backend/SQL.hs +261/−34
• Database/Beam/Backend/SQL/AST.hs +33/−14
• Database/Beam/Backend/SQL/BeamExtensions.hs +91/−19
• Database/Beam/Backend/SQL/Builder.hs +49/−28
• Database/Beam/Backend/SQL/Row.hs +200/−0
• Database/Beam/Backend/SQL/SQL2003.hs +7/−3
• Database/Beam/Backend/SQL/SQL92.hs +78/−21
• Database/Beam/Backend/SQL/SQL99.hs +26/−2
• Database/Beam/Backend/SQL/Types.hs +1/−7
• Database/Beam/Backend/Types.hs +4/−144
• Database/Beam/Backend/URI.hs +16/−18
• Database/Beam/Query.hs +243/−133
• Database/Beam/Query/Aggregate.hs +77/−60
• Database/Beam/Query/CTE.hs +89/−0
• Database/Beam/Query/Combinators.hs +354/−425
• Database/Beam/Query/CustomSQL.hs +13/−8
• Database/Beam/Query/DataTypes.hs +115/−0
• Database/Beam/Query/Extensions.hs +35/−29
• Database/Beam/Query/Extract.hs +61/−0
• Database/Beam/Query/Internal.hs +335/−176
• Database/Beam/Query/Operator.hs +39/−40
• Database/Beam/Query/Ord.hs +146/−184
• Database/Beam/Query/Relationships.hs +56/−70
• Database/Beam/Query/SQL92.hs +133/−144
• Database/Beam/Query/Types.hs +12/−11
• Database/Beam/Schema.hs +1/−0
• Database/Beam/Schema/Tables.hs +104/−48
• beam-core.cabal +8/−2
• test/Database/Beam/Test/SQL.hs +131/−118
• test/Database/Beam/Test/Schema.hs +44/−39

@@ -1,3 +1,86 @@+# 0.8.0.0++## Common table expressions++Beam now supports common table expressions on some backends, using the+`With` monad. Currently, only `SELECT` statements are supported.++## Changes to field name modification++`EntityModification` is now a `Monoid`.++Instead of taking the beam-determined name, the `renamingFields`+function instead takes a `Data.List.NonEmpty` value containing the+names of each Haskell record selector that led to this field.++For example, in the following++```haskell+data Embedded f =+  Embedded { _field1 :: Columnar f Text+           , _field2 :: Columnar f Int }++data Table1 f =+  Table1 { _tbl1FieldA :: Columnar f Text+         , _tbl1Embedded :: Embedded f }++db = defaultDbSettings `withDbModification`+     dbModification { table1 = renamingFields f }+```++`f` would be called with `["_tbl1FieldA"]`, `["_tbl1Embedded", "_field1"]`+and `["_tbl1Embedded", "_field2"]`.+++## Simplified types++Every beam SQL backend is now an instance of `BeamSqlBackend` and has an+associated syntax via an associated type family. This means types are much simpler.++Another benefit is that `MonadBeam` now has a simpler type and can be used with+monad transformers. For example, writing a computation that may call out to a+postgres database is as simple as++```haskell+dbComputation :: MonadBeam Postgres m => m result+```++versus before++```haskell+dbComputation :: MonadBeam PgCommandSyntax Postgres Pg.Connection m => m result+```++Things become simpler if you want to write database agnostic computations. You can now do++```haskell+dbComputation :: (BeamSqlBackend be, MonadBeam be m) => m result+```++versus before++```haskell+dbComputation :: ( Sql92SanityCheck syntax, MonadBeam syntax be hdl m ) => m result+```++## Removal of `HasDefaultSqlDataTypeConstraints`++The changes above make a separate `HasDefaultSqlDataTypeConstraints`+class unnecessary. The `defaultSqlDataTypeConstraints` method is now+included within the `HasDefaultSqlDataType` class.++## Changes to parseOneField and peekField++Formerly, the `peekField` function would attemt to parse a field+without advancing the column pointer, regardless of whether a field+was successfully parsed. In order to support more efficient parsing,+this has been changed. When `peekField` returns a `Just` value, then+the column pointer is advanced to the next pointer. This means you do+not need to call `parseOneField` again to advance the pointer.++You can still chain `peekField` calls together by using the new+`Alternative` instance for `FromBackendRowM`.+ # 0.7.2.0  Add compatibility with GHC 8.4 and stack nightly

@@ -6,12 +6,10 @@ -- --   This is mainly reference documentation. Most users will want to consult the --   [manual](https://tathougies.github.io/beam).------   The API has mostly stayed the same, but not all the examples given there compile. module Database.Beam      ( module Database.Beam.Query      , module Database.Beam.Schema-     , MonadBeam(withDatabase, withDatabaseDebug)+     , MonadBeam(..)      , FromBackendRow(..)         -- * Re-exports

@@ -1,6 +1,7 @@ module Database.Beam.Backend   ( module Database.Beam.Backend.Types-  , MonadBeam(..) ) where+  , module Database.Beam.Backend.SQL+  ) where  import Database.Beam.Backend.Types import Database.Beam.Backend.SQL

@@ -1,50 +1,101 @@+{-# LANGUAGE UndecidableInstances #-} module Database.Beam.Backend.SQL-  ( module Database.Beam.Backend.SQL.SQL2003+  ( module Database.Beam.Backend.SQL.Row+  , module Database.Beam.Backend.SQL.SQL2003   , module Database.Beam.Backend.SQL.Types-  , module Database.Beam.Backend.Types -  , MonadBeam(..) ) where+  , MonadBeam(..) +  , BeamSqlBackend+  , BeamSqlBackendSyntax+  , MockSqlBackend++  , BeamSqlBackendIsString++  , BeamSql99ExpressionBackend+  , BeamSql99AggregationBackend+  , BeamSql99ConcatExpressionBackend+  , BeamSql99CommonTableExpressionBackend+  , BeamSql99RecursiveCTEBackend+  , BeamSql2003ExpressionBackend++  , BeamSqlT021Backend+  , BeamSqlT071Backend+  , BeamSqlT611Backend+  , BeamSqlT612Backend+  , BeamSqlT614Backend+  , BeamSqlT615Backend+  , BeamSqlT616Backend+  , BeamSqlT618Backend+  , BeamSqlT621Backend+  , BeamSql99DataTypeBackend++  , BeamSqlBackendSupportsOuterJoin++  , BeamSqlBackendSelectSyntax+  , BeamSqlBackendInsertSyntax+  , BeamSqlBackendInsertValuesSyntax+  , BeamSqlBackendUpdateSyntax+  , BeamSqlBackendDeleteSyntax+  , BeamSqlBackendCastTargetSyntax+  , BeamSqlBackendSelectTableSyntax+  , BeamSqlBackendAggregationQuantifierSyntax+  , BeamSqlBackendSetQuantifierSyntax+  , BeamSqlBackendFromSyntax+  , BeamSqlBackendTableNameSyntax++  , BeamSqlBackendExpressionSyntax+  , BeamSqlBackendDataTypeSyntax+  , BeamSqlBackendFieldNameSyntax+  , BeamSqlBackendExpressionQuantifierSyntax+  , BeamSqlBackendValueSyntax+  , BeamSqlBackendOrderingSyntax+  , BeamSqlBackendGroupingSyntax++  , BeamSqlBackendWindowFrameSyntax+  , BeamSqlBackendWindowFrameBoundsSyntax+  , BeamSqlBackendWindowFrameBoundSyntax++  , BeamSql99BackendCTESyntax++  , BeamSqlBackendCanSerialize+  , BeamSqlBackendCanDeserialize+  , BeamSqlBackendSupportsDataType+  ) where+ import Database.Beam.Backend.SQL.SQL2003+import Database.Beam.Backend.SQL.Row import Database.Beam.Backend.SQL.Types import Database.Beam.Backend.Types -import Control.Monad.IO.Class-import Control.Monad.Fail (MonadFail)+import Control.Monad.Cont+import Control.Monad.Except+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.RWS.Strict as Strict+import Control.Monad.Reader+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict+import qualified Control.Monad.Writer.Strict as Strict +import Data.Tagged (Tagged)+import Data.Text (Text)+ -- * MonadBeam class --- | A class that ties together a Sql syntax, backend, handle, and monad type.------   Intuitively, this allows you to write code that performs database commands---   without having to know the underlying API. As long as you have an---   appropriate handle from a database library that Beam can use, you can use---   the 'MonadBeam' methods to execute the query.+-- | A class that ties together a monad with a particular backend -----   Provided here is a low-level interface. Most often, you'll only need the---   'withDatabase' and 'withDatabaseDebug' function. The 'run*' functions are---   wrapped by the appropriate functions in "Database.Beam.Query".+--   Provided here is a low-level interface for executing commands. The 'run*'+--   functions are wrapped by the appropriate functions in 'Database.Beam.Query'. -- --   This interface is very high-level and isn't meant to expose the full power --   of the underlying database. Namely, it only supports simple data retrieval --   strategies. More complicated strategies (for example, Postgres's @COPY@) --   are supported in individual backends. See the documentation of those --   backends for more details.-class (BeamBackend be, Monad m, MonadIO m, MonadFail m, Sql92SanityCheck syntax) =>-  MonadBeam syntax be handle m | m -> syntax be handle where--  {-# MINIMAL withDatabaseDebug, runReturningMany #-}--  -- | Run a database action, and log debugging information about statements-  --   executed using the specified 'IO' action.-  withDatabaseDebug :: (String -> IO ()) -- ^ Database statement logging function-                    -> handle            -- ^ The database connection handle against which to execute the action-                    -> m a               -- ^ The database action-                    -> IO a-  withDatabase :: handle -> m a -> IO a--  -- | Run a database action, but don't report any debug information-  withDatabase = withDatabaseDebug (\_ -> pure ())+class (BeamBackend be, Monad m) =>+  MonadBeam be m | m -> be where+  {-# MINIMAL runReturningMany #-}    -- | Run a query determined by the given syntax, providing an action that will   --   be called to consume the results from the database (if any). The action@@ -52,20 +103,23 @@   --   this reader action returns 'Nothing', there are no rows left to consume.   --   When the reader action returns, the database result is freed.   runReturningMany :: FromBackendRow be x-                   => syntax               -- ^ The query to run-                   -> (m (Maybe x) -> m a) -- ^ Reader action that will be called with a function to fetch the next row+                   => BeamSqlBackendSyntax be+                      -- ^ The query to run+                   -> (m (Maybe x) -> m a)+                       -- ^ Reader action that will be called with a function to+                       -- fetch the next row                    -> m a    -- | Run the given command and don't consume any results. Useful for DML   --   statements like INSERT, UPDATE, and DELETE, or DDL statements.-  runNoReturn :: syntax -> m ()+  runNoReturn :: BeamSqlBackendSyntax be -> m ()   runNoReturn cmd =       runReturningMany cmd $ \(_ :: m (Maybe ())) -> pure ()    -- | Run the given command and fetch the unique result. The result is   --   'Nothing' if either no results are returned or more than one result is   --   returned.-  runReturningOne :: FromBackendRow be x => syntax -> m (Maybe x)+  runReturningOne :: FromBackendRow be x => BeamSqlBackendSyntax be -> m (Maybe x)   runReturningOne cmd =       runReturningMany cmd $ \next ->         do a <- next@@ -80,7 +134,7 @@   -- | Run the given command, collect all the results, and return them as a   --   list. May be more convenient than 'runReturningMany', but reads the entire   --   result set into memory.-  runReturningList :: FromBackendRow be x => syntax -> m [x]+  runReturningList :: FromBackendRow be x => BeamSqlBackendSyntax be -> m [x]   runReturningList cmd =       runReturningMany cmd $ \next ->           let collectM acc = do@@ -89,3 +143,176 @@                   Nothing -> pure (acc [])                   Just x -> collectM (acc . (x:))           in collectM id++instance MonadBeam be m => MonadBeam be (ExceptT e m) where+    runReturningMany s a = ExceptT $ runReturningMany s (\nextRow -> runExceptT (a (lift nextRow)))+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance MonadBeam be m => MonadBeam be (ContT r m) where+    runReturningMany s a = ContT $ \r ->+                           runReturningMany s (\nextRow -> runContT (a (lift nextRow)) r)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance MonadBeam be m => MonadBeam be (ReaderT r m) where+    runReturningMany s a = ReaderT $ \r ->+                           runReturningMany s (\nextRow -> runReaderT (a (lift nextRow)) r)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance MonadBeam be m => MonadBeam be (Lazy.StateT s m) where+    runReturningMany s a = Lazy.StateT $ \st ->+                           runReturningMany s (\nextRow -> Lazy.runStateT (a (lift nextRow)) st)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance MonadBeam be m => MonadBeam be (Strict.StateT s m) where+    runReturningMany s a = Strict.StateT $ \st ->+                           runReturningMany s (\nextRow -> Strict.runStateT (a (lift nextRow)) st)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance (MonadBeam be m, Monoid s) => MonadBeam be (Lazy.WriterT s m) where+    runReturningMany s a = Lazy.WriterT $+                           runReturningMany s (\nextRow -> Lazy.runWriterT (a (lift nextRow)))+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance (MonadBeam be m, Monoid s) => MonadBeam be (Strict.WriterT s m) where+    runReturningMany s a = Strict.WriterT $+                           runReturningMany s (\nextRow -> Strict.runWriterT (a (lift nextRow)))+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance (MonadBeam be m, Monoid w) => MonadBeam be (Lazy.RWST r w s m) where+    runReturningMany s a = Lazy.RWST $ \r st ->+                           runReturningMany s (\nextRow -> Lazy.runRWST (a (lift nextRow)) r st)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++instance (MonadBeam be m, Monoid w) => MonadBeam be (Strict.RWST r w s m) where+    runReturningMany s a = Strict.RWST $ \r st ->+                           runReturningMany s (\nextRow -> Strict.runRWST (a (lift nextRow)) r st)+    runNoReturn = lift . runNoReturn+    runReturningOne = lift . runReturningOne+    runReturningList = lift . runReturningList++-- * BeamSqlBackend++-- | Class for all Beam SQL backends+class ( -- Every SQL backend must be a beam backend+        BeamBackend be++        -- Every SQL backend must have a reasonable SQL92 semantics+      , IsSql92Syntax (BeamSqlBackendSyntax be)+      , Sql92SanityCheck (BeamSqlBackendSyntax be)++        -- Needed for several combinators+      , HasSqlValueSyntax (BeamSqlBackendValueSyntax be) Bool+      , HasSqlValueSyntax (BeamSqlBackendValueSyntax be) SqlNull++        -- Needed for the Eq instance on QGenExpr+      , Eq (BeamSqlBackendExpressionSyntax be)+      ) => BeamSqlBackend be++type family BeamSqlBackendSyntax be :: *++-- | Fake backend that cannot deserialize anything, but is useful for testing+data MockSqlBackend syntax++class Trivial a+instance Trivial a++instance BeamBackend (MockSqlBackend syntax) where+  type BackendFromField (MockSqlBackend syntax) = Trivial++instance ( IsSql92Syntax syntax+         , Sql92SanityCheck syntax++           -- Needed for several combinators+         , HasSqlValueSyntax (Sql92ValueSyntax syntax) Bool+         , HasSqlValueSyntax (Sql92ValueSyntax syntax) SqlNull++           -- Needed for the Eq instance on QGenExpr+         , Eq (Sql92ExpressionSyntax syntax)+         ) => BeamSqlBackend (MockSqlBackend syntax)+type instance BeamSqlBackendSyntax (MockSqlBackend syntax) = syntax++-- | Type class for things which are text-like in this backend+class BeamSqlBackendIsString be text+instance BeamSqlBackendIsString be t => BeamSqlBackendIsString be (Tagged tag t)+instance BeamSqlBackendIsString (MockSqlBackend cmd) Text+instance BeamSqlBackendIsString (MockSqlBackend cmd) [Char]++type BeamSql99ExpressionBackend be = IsSql99ExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSql99ConcatExpressionBackend be = IsSql99ConcatExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSql99CommonTableExpressionBackend be =+    ( BeamSqlBackend be+    , IsSql99CommonTableExpressionSelectSyntax (BeamSqlBackendSelectSyntax be)+    , IsSql99CommonTableExpressionSyntax (BeamSql99BackendCTESyntax be)+    , Sql99CTESelectSyntax (BeamSql99BackendCTESyntax be) ~ BeamSqlBackendSelectSyntax be )+type BeamSql99RecursiveCTEBackend be=+    ( BeamSql99CommonTableExpressionBackend be+    , IsSql99RecursiveCommonTableExpressionSelectSyntax (BeamSqlBackendSelectSyntax be) )+type BeamSql99AggregationBackend be = IsSql99AggregationExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSql2003ExpressionBackend be = ( IsSql2003ExpressionSyntax (BeamSqlBackendExpressionSyntax be)+                                       , Sql2003SanityCheck (BeamSqlBackendSyntax be) )++type BeamSqlBackendSupportsOuterJoin be = IsSql92FromOuterJoinSyntax (BeamSqlBackendFromSyntax be)++type BeamSqlT021Backend be = IsSql2003BinaryAndVarBinaryDataTypeSyntax (BeamSqlBackendCastTargetSyntax be)+type BeamSqlT071Backend be = IsSql2008BigIntDataTypeSyntax (BeamSqlBackendCastTargetSyntax be)+type BeamSqlT611Backend be = IsSql2003ExpressionElementaryOLAPOperationsSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT612Backend be = IsSql2003ExpressionAdvancedOLAPOperationsSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT614Backend be = IsSql2003NtileExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT615Backend be = IsSql2003LeadAndLagExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT616Backend be = IsSql2003FirstValueAndLastValueExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT618Backend be = IsSql2003NthValueExpressionSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlT621Backend be =+  ( IsSql2003EnhancedNumericFunctionsExpressionSyntax (BeamSqlBackendExpressionSyntax be)+  , IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax (BeamSqlBackendExpressionSyntax be) )++type BeamSql99DataTypeBackend be =+    ( BeamSqlBackend be+    , IsSql99DataTypeSyntax (BeamSqlBackendCastTargetSyntax be) )++type BeamSqlBackendSelectSyntax be = Sql92SelectSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendInsertSyntax be = Sql92InsertSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendInsertValuesSyntax be = Sql92InsertValuesSyntax (BeamSqlBackendInsertSyntax be)+type BeamSqlBackendExpressionSyntax be = Sql92ExpressionSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendDataTypeSyntax be = Sql92ExpressionCastTargetSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlBackendFieldNameSyntax be = Sql92ExpressionFieldNameSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlBackendUpdateSyntax be = Sql92UpdateSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendDeleteSyntax be = Sql92DeleteSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendCastTargetSyntax be+    = Sql92ExpressionCastTargetSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlBackendExpressionQuantifierSyntax be = Sql92ExpressionQuantifierSyntax (Sql92ExpressionSyntax (BeamSqlBackendSyntax be))+type BeamSqlBackendValueSyntax be = Sql92ValueSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendSetQuantifierSyntax be = Sql92SelectTableSetQuantifierSyntax (BeamSqlBackendSelectTableSyntax be)+type BeamSqlBackendAggregationQuantifierSyntax be = Sql92AggregationSetQuantifierSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlBackendSelectTableSyntax be = Sql92SelectSelectTableSyntax (BeamSqlBackendSelectSyntax be)+type BeamSqlBackendFromSyntax be = Sql92SelectFromSyntax (BeamSqlBackendSelectSyntax be)+type BeamSqlBackendTableNameSyntax be =  Sql92TableSourceTableNameSyntax (Sql92FromTableSourceSyntax (BeamSqlBackendFromSyntax be))+type BeamSqlBackendOrderingSyntax be = Sql92SelectOrderingSyntax (BeamSqlBackendSelectSyntax be)+type BeamSqlBackendGroupingSyntax be = Sql92SelectTableGroupingSyntax (BeamSqlBackendSelectTableSyntax be)++type BeamSqlBackendWindowFrameSyntax be = Sql2003ExpressionWindowFrameSyntax (BeamSqlBackendExpressionSyntax be)+type BeamSqlBackendWindowFrameBoundsSyntax be = Sql2003WindowFrameBoundsSyntax (BeamSqlBackendWindowFrameSyntax be)+type BeamSqlBackendWindowFrameBoundSyntax be = Sql2003WindowFrameBoundsBoundSyntax (BeamSqlBackendWindowFrameBoundsSyntax be)++type BeamSql99BackendCTESyntax be = Sql99SelectCTESyntax (BeamSqlBackendSelectSyntax be)++type BeamSqlBackendCanSerialize be = HasSqlValueSyntax (BeamSqlBackendValueSyntax be)+type BeamSqlBackendCanDeserialize be = FromBackendRow be+type BeamSqlBackendSupportsDataType be x =+  ( BeamSqlBackendCanDeserialize be x+  , BeamSqlBackendCanSerialize be x )

@@ -77,13 +77,14 @@  data Insert   = Insert-  { insertTable :: Text+  { insertTable :: TableName   , insertFields :: [ Text ]   , insertValues :: InsertValues }   deriving (Show, Eq)  instance IsSql92InsertSyntax Insert where   type Sql92InsertValuesSyntax Insert = InsertValues+  type Sql92InsertTableNameSyntax Insert = TableName    insertStmt = Insert @@ -103,12 +104,13 @@  data Update   = Update-  { updateTable :: Text+  { updateTable :: TableName   , updateFields :: [ (FieldName, Expression) ]   , updateWhere :: Maybe Expression }   deriving (Show, Eq)  instance IsSql92UpdateSyntax Update where+  type Sql92UpdateTableNameSyntax Update = TableName   type Sql92UpdateFieldNameSyntax Update = FieldName   type Sql92UpdateExpressionSyntax Update = Expression @@ -116,12 +118,13 @@  data Delete   = Delete-  { deleteTable :: Text+  { deleteTable :: TableName   , deleteAlias :: Maybe Text   , deleteWhere :: Maybe Expression }   deriving (Show, Eq)  instance IsSql92DeleteSyntax Delete where+  type Sql92DeleteTableNameSyntax Delete = TableName   type Sql92DeleteExpressionSyntax Delete = Expression    deleteStmt = Delete@@ -157,11 +160,6 @@   | ExtractFieldDateTimeSecond   deriving (Show, Eq) -data CastTarget-  = CastTargetDataType DataType-  | CastTargetDomainName Text-  deriving (Show, Eq)- data DataType   = DataTypeChar Bool {- Varying -} (Maybe Word) (Maybe Text)   | DataTypeNationalChar Bool (Maybe Word)@@ -256,7 +254,7 @@   | ExpressionUnOp Text Expression    | ExpressionPosition Expression Expression-  | ExpressionCast Expression CastTarget+  | ExpressionCast Expression DataType   | ExpressionExtract ExtractField Expression   | ExpressionCharLength Expression   | ExpressionOctetLength Expression@@ -266,6 +264,7 @@   | ExpressionUpper Expression   | ExpressionTrim Expression +  | ExpressionNamedFunction Text   | ExpressionFunctionCall Expression [ Expression ]   | ExpressionInstanceField Expression Text   | ExpressionRefField Expression Text@@ -284,14 +283,20 @@   | ExpressionCurrentTimestamp   deriving (Show, Eq) -instance IsSqlExpressionSyntaxStringType Expression Text+instance IsSql92ExtractFieldSyntax ExtractField where+  secondsField = ExtractFieldDateTimeSecond+  minutesField = ExtractFieldDateTimeMinute+  hourField = ExtractFieldDateTimeHour+  dayField = ExtractFieldDateTimeDay+  monthField = ExtractFieldDateTimeMonth+  yearField = ExtractFieldDateTimeYear  instance IsSql92ExpressionSyntax Expression where   type Sql92ExpressionQuantifierSyntax Expression = ComparatorQuantifier   type Sql92ExpressionValueSyntax Expression = Value   type Sql92ExpressionSelectSyntax Expression = Select   type Sql92ExpressionFieldNameSyntax Expression = FieldName-  type Sql92ExpressionCastTargetSyntax Expression = CastTarget+  type Sql92ExpressionCastTargetSyntax Expression = DataType   type Sql92ExpressionExtractFieldSyntax Expression = ExtractField    valueE = ExpressionValue@@ -353,10 +358,13 @@   defaultE = ExpressionDefault   inE = ExpressionIn +instance IsSql99FunctionExpressionSyntax Expression where+  functionNameE = ExpressionNamedFunction+  functionCallE = ExpressionFunctionCall+ instance IsSql99ExpressionSyntax Expression where   distinctE = ExpressionDistinct   similarToE = ExpressionBinOp "SIMILAR TO"-  functionCallE = ExpressionFunctionCall   instanceFieldE = ExpressionInstanceField   refFieldE = ExpressionRefField @@ -423,6 +431,7 @@   type Sql2003ExpressionWindowFrameSyntax Expression = WindowFrame    overE = ExpressionOver+  rowNumberE = ExpressionAgg "ROW_NUMBER" Nothing []  newtype Projection   = ProjExprs [ (Expression, Maybe Text ) ]@@ -451,19 +460,29 @@    groupByExpressions = Grouping +data TableName = TableName (Maybe Text) Text+  deriving (Show, Eq, Ord)++instance IsSql92TableNameSyntax TableName where+  tableName = TableName+ data TableSource-  = TableNamed Text+  = TableNamed TableName   | TableFromSubSelect Select+  | TableFromValues [ [ Expression ] ]   deriving (Show, Eq)  instance IsSql92TableSourceSyntax TableSource where   type Sql92TableSourceSelectSyntax TableSource = Select+  type Sql92TableSourceExpressionSyntax TableSource = Expression+  type Sql92TableSourceTableNameSyntax TableSource = TableName    tableNamed = TableNamed   tableFromSubSelect = TableFromSubSelect+  tableFromValues = TableFromValues  data From-  = FromTable TableSource (Maybe Text)+  = FromTable TableSource (Maybe (Text, Maybe [Text]))   | InnerJoin From From (Maybe Expression)   | LeftJoin From From (Maybe Expression)   | RightJoin From From (Maybe Expression)

@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances #-} -- | Some functionality is useful enough to be provided across backends, but is -- not standardized. For example, many RDBMS systems provide ways of fetching -- auto-incrementing or defaulting fields on INSERT or UPDATE.@@ -14,50 +15,121 @@   ) where  import Database.Beam.Backend-import Database.Beam.Backend.SQL import Database.Beam.Query-import Database.Beam.Query.Internal import Database.Beam.Schema  import Control.Monad.Identity+import Control.Monad.Cont+import Control.Monad.Except+import qualified Control.Monad.RWS.Lazy as Lazy+import qualified Control.Monad.RWS.Strict as Strict+import Control.Monad.Reader+import qualified Control.Monad.State.Lazy as Lazy+import qualified Control.Monad.Writer.Lazy as Lazy+import qualified Control.Monad.State.Strict as Strict+import qualified Control.Monad.Writer.Strict as Strict  --import GHC.Generics  -- | 'MonadBeam's that support returning the newly created rows of an @INSERT@ statement. --   Useful for discovering the real value of a defaulted value.-class MonadBeam syntax be handle m =>-  MonadBeamInsertReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where+class MonadBeam be m =>+  MonadBeamInsertReturning be m | m -> be where   runInsertReturningList     :: ( Beamable table-       , Projectible (Sql92ExpressionSyntax syntax) (table (QExpr (Sql92ExpressionSyntax syntax) ()))+       , Projectible be (table (QExpr be ()))        , FromBackendRow be (table Identity) )-    => DatabaseEntity be db (TableEntity table)-    -> SqlInsertValues (Sql92InsertValuesSyntax (Sql92InsertSyntax syntax))-                       (table (QExpr (Sql92InsertExpressionSyntax (Sql92InsertSyntax syntax)) s))+    => SqlInsert be table     -> m [table Identity] +instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ExceptT e m) where+    runInsertReturningList = lift . runInsertReturningList+instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ContT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (ReaderT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Lazy.StateT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance MonadBeamInsertReturning be m => MonadBeamInsertReturning be (Strict.StateT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance (MonadBeamInsertReturning be m, Monoid r)+    => MonadBeamInsertReturning be (Lazy.WriterT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance (MonadBeamInsertReturning be m, Monoid r)+    => MonadBeamInsertReturning be (Strict.WriterT r m) where+    runInsertReturningList = lift . runInsertReturningList+instance (MonadBeamInsertReturning be m, Monoid w)+    => MonadBeamInsertReturning be (Lazy.RWST r w s m) where+    runInsertReturningList = lift . runInsertReturningList+instance (MonadBeamInsertReturning be m, Monoid w)+    => MonadBeamInsertReturning be (Strict.RWST r w s m) where+    runInsertReturningList = lift . runInsertReturningList+ -- | 'MonadBeam's that support returning the updated rows of an @UPDATE@ statement. --   Useful for discovering the new values of the updated rows.-class MonadBeam syntax be handle m =>-  MonadBeamUpdateReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where+class MonadBeam be m =>+  MonadBeamUpdateReturning be m | m -> be where   runUpdateReturningList     :: ( Beamable table-       , Projectible (Sql92ExpressionSyntax syntax) (table (QExpr (Sql92ExpressionSyntax syntax) ()))+       , Projectible be (table (QExpr be ()))        , FromBackendRow be (table Identity) )-    => DatabaseEntity be db (TableEntity table)-    -> (forall s. table (QField s) -> [ QAssignment (Sql92UpdateFieldNameSyntax (Sql92UpdateSyntax syntax)) (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s ])-    -> (forall s. table (QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s) -> QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s Bool)+    => SqlUpdate be table     -> m [table Identity] +instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ExceptT e m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ContT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (ReaderT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Lazy.StateT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance MonadBeamUpdateReturning be m => MonadBeamUpdateReturning be (Strict.StateT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance (MonadBeamUpdateReturning be m, Monoid r)+    => MonadBeamUpdateReturning be (Lazy.WriterT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance (MonadBeamUpdateReturning be m, Monoid r)+    => MonadBeamUpdateReturning be (Strict.WriterT r m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance (MonadBeamUpdateReturning be m, Monoid w)+    => MonadBeamUpdateReturning be (Lazy.RWST r w s m) where+    runUpdateReturningList = lift . runUpdateReturningList+instance (MonadBeamUpdateReturning be m, Monoid w)+    => MonadBeamUpdateReturning be (Strict.RWST r w s m) where+    runUpdateReturningList = lift . runUpdateReturningList+ -- | 'MonadBeam's that suppert returning rows that will be deleted by the given -- @DELETE@ statement. Useful for deallocating resources based on the value of -- deleted rows.-class MonadBeam syntax be handle m =>-  MonadBeamDeleteReturning syntax be handle m | m -> syntax be handle, be -> m, handle -> m where+class MonadBeam be m =>+  MonadBeamDeleteReturning be m | m -> be where   runDeleteReturningList     :: ( Beamable table-       , Projectible (Sql92ExpressionSyntax syntax) (table (QExpr (Sql92ExpressionSyntax syntax) ()))+       , Projectible be (table (QExpr be ()))        , FromBackendRow be (table Identity) )-    => DatabaseEntity be db (TableEntity table)-    -> (forall s. table (QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s) -> QExpr (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax syntax)) s Bool)+    => SqlDelete be table     -> m [table Identity]++instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ExceptT e m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ContT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (ReaderT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Lazy.StateT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance MonadBeamDeleteReturning be m => MonadBeamDeleteReturning be (Strict.StateT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance (MonadBeamDeleteReturning be m, Monoid r)+    => MonadBeamDeleteReturning be (Lazy.WriterT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance (MonadBeamDeleteReturning be m, Monoid r)+    => MonadBeamDeleteReturning be (Strict.WriterT r m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance (MonadBeamDeleteReturning be m, Monoid w)+    => MonadBeamDeleteReturning be (Lazy.RWST r w s m) where+    runDeleteReturningList = lift . runDeleteReturningList+instance (MonadBeamDeleteReturning be m, Monoid w)+    => MonadBeamDeleteReturning be (Strict.RWST r w s m) where+    runDeleteReturningList = lift . runDeleteReturningList

@@ -13,12 +13,13 @@ --   Always use the provided backends to submit queries and data manipulation --   commands to the database. module Database.Beam.Backend.SQL.Builder-  ( SqlSyntaxBuilder(..), SqlSyntaxBackend+  ( SqlSyntaxBuilder(..) --, SqlSyntaxBackend   , buildSepBy   , quoteSql   , renderSql ) where  import           Database.Beam.Backend.SQL+--import           Database.Beam.Backend.Types  import           Control.Monad.IO.Class @@ -126,10 +127,11 @@  instance IsSql92InsertSyntax SqlSyntaxBuilder where   type Sql92InsertValuesSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  type Sql92InsertTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder -  insertStmt table fields values =+  insertStmt tblNm fields values =     SqlSyntaxBuilder $-    byteString "INSERT INTO " <> quoteSql table <>+    byteString "INSERT INTO " <> buildSql tblNm <>     byteString "(" <> buildSepBy (byteString ", ") (map quoteSql fields) <> byteString ") " <>     buildSql values @@ -151,10 +153,11 @@ instance IsSql92UpdateSyntax SqlSyntaxBuilder where   type Sql92UpdateFieldNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder   type Sql92UpdateExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  type Sql92UpdateTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder -  updateStmt table set where_ =+  updateStmt tblNm set where_ =     SqlSyntaxBuilder $-    byteString "UPDATE " <> quoteSql table <>+    byteString "UPDATE " <> buildSql tblNm <>     (case set of        [] -> mempty        es -> byteString " SET " <> buildSepBy (byteString ", ") (map (\(field, expr) -> buildSql field <> byteString "=" <> buildSql expr) es)) <>@@ -162,10 +165,11 @@  instance IsSql92DeleteSyntax SqlSyntaxBuilder where   type Sql92DeleteExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  type Sql92DeleteTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder -  deleteStmt tbl alias where_ =+  deleteStmt tblNm alias where_ =     SqlSyntaxBuilder $-    byteString "DELETE FROM " <> quoteSql tbl <>+    byteString "DELETE FROM " <> buildSql tblNm <>     maybe mempty (\alias_ -> byteString " AS " <> quoteSql alias_) alias <>     maybe mempty (\where_ -> byteString " WHERE " <> buildSql where_) where_ @@ -180,12 +184,18 @@     SqlSyntaxBuilder $     byteString "`" <> stringUtf8 (T.unpack a) <> byteString "`" -instance IsSqlExpressionSyntaxStringType SqlSyntaxBuilder Text- instance IsSql92QuantifierSyntax SqlSyntaxBuilder where   quantifyOverAll = SqlSyntaxBuilder "ALL"   quantifyOverAny = SqlSyntaxBuilder "ANY" +instance IsSql92ExtractFieldSyntax SqlSyntaxBuilder where+  secondsField = SqlSyntaxBuilder (byteString "SECOND")+  minutesField = SqlSyntaxBuilder (byteString "MINUTE")+  hourField    = SqlSyntaxBuilder (byteString "HOUR")+  dayField     = SqlSyntaxBuilder (byteString "DAY")+  monthField   = SqlSyntaxBuilder (byteString "MONTH")+  yearField    = SqlSyntaxBuilder (byteString "YEAR")+ instance IsSql92ExpressionSyntax SqlSyntaxBuilder where   type Sql92ExpressionValueSyntax SqlSyntaxBuilder = SqlSyntaxBuilder   type Sql92ExpressionSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder@@ -221,7 +231,7 @@   positionE needle haystack =     SqlSyntaxBuilder $ byteString "POSITION(" <> buildSql needle <> byteString ") IN (" <> buildSql haystack <> byteString ")"   extractE what from =-    SqlSyntaxBuilder $ buildSql what <> byteString " FROM (" <> buildSql from <> byteString ")"+    SqlSyntaxBuilder $ byteString "EXTRACT(" <> buildSql what <> byteString " FROM (" <> buildSql from <> byteString "))"   absE = sqlFuncOp "ABS"   charLengthE = sqlFuncOp "CHAR_LENGTH"   bitLengthE = sqlFuncOp "BIT_LENGTH"@@ -266,10 +276,8 @@   inE a es = SqlSyntaxBuilder (byteString "(" <> buildSql a <> byteString ") IN (" <>                                buildSepBy (byteString ", ") (map buildSql es)) -instance IsSql99ExpressionSyntax SqlSyntaxBuilder where-  distinctE = sqlUnOp "DISTINCT"-  similarToE = sqlBinOp "SIMILAR TO"-+instance IsSql99FunctionExpressionSyntax SqlSyntaxBuilder where+  functionNameE fn = SqlSyntaxBuilder (byteString (TE.encodeUtf8 fn))   functionCallE function args =     SqlSyntaxBuilder $     buildSql function <>@@ -277,6 +285,10 @@     buildSepBy (byteString ", ") (map buildSql args) <>     byteString ")" +instance IsSql99ExpressionSyntax SqlSyntaxBuilder where+  distinctE = sqlUnOp "DISTINCT"+  similarToE = sqlBinOp "SIMILAR TO"+   instanceFieldE e fieldNm =     SqlSyntaxBuilder $     byteString "(" <> buildSql e <> byteString ")." <> byteString (TE.encodeUtf8 fieldNm)@@ -290,6 +302,7 @@   overE expr frame =       SqlSyntaxBuilder $       buildSql expr <> buildSql frame+  rowNumberE = SqlSyntaxBuilder (byteString "ROW_NUMBER()")  instance IsSql2003WindowFrameSyntax SqlSyntaxBuilder where   type Sql2003WindowFrameExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder@@ -378,16 +391,32 @@   descOrdering expr = SqlSyntaxBuilder (buildSql expr <> byteString " DESC")  instance IsSql92TableSourceSyntax SqlSyntaxBuilder where+  type Sql92TableSourceTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder   type Sql92TableSourceSelectSyntax SqlSyntaxBuilder = SqlSyntaxBuilder-  tableNamed t = SqlSyntaxBuilder (quoteSql t)+  type Sql92TableSourceExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder++  tableNamed = id   tableFromSubSelect query = SqlSyntaxBuilder (byteString "(" <> buildSql query <> byteString ")")+  tableFromValues vss =+      SqlSyntaxBuilder $+      byteString "VALUES " <>+      buildSepBy (byteString ", ")+       (map (\vs -> byteString "(" <>+                    buildSepBy (byteString ", ") (map buildSql vs) <>+                    byteString ")") vss) +instance IsSql92TableNameSyntax SqlSyntaxBuilder where+  tableName Nothing t  = SqlSyntaxBuilder $ quoteSql t+  tableName (Just s) t = SqlSyntaxBuilder $ quoteSql s <> byteString "." <> quoteSql t+ instance IsSql92FromSyntax SqlSyntaxBuilder where     type Sql92FromTableSourceSyntax SqlSyntaxBuilder = SqlSyntaxBuilder     type Sql92FromExpressionSyntax SqlSyntaxBuilder = SqlSyntaxBuilder      fromTable t Nothing = t-    fromTable t (Just nm) = SqlSyntaxBuilder (buildSql t <> byteString " AS " <> quoteSql nm)+    fromTable t (Just (nm, colNms)) =+        SqlSyntaxBuilder (buildSql t <> byteString " AS " <> quoteSql nm <>+                          maybe mempty (\colNms' -> byteString "(" <> buildSepBy (byteString ", ") (map quoteSql colNms') <> byteString ")") colNms)      innerJoin = join "INNER JOIN"     leftJoin = join "LEFT JOIN"@@ -497,21 +526,13 @@   SqlSyntaxBuilder $   byteString fun <> byteString "(" <> buildSql a <> byteString")" --- * Fake 'MonadBeam' instance (for using 'SqlSyntaxBuilder' with migrations mainly) -data SqlSyntaxBackend+-- * Fake 'MonadBeam' instance (for using 'SqlSyntaxBuilder' with migrations mainly) -class Trivial a-instance Trivial a+-- data SqlSyntaxBackend -instance BeamBackend SqlSyntaxBackend where-  type BackendFromField SqlSyntaxBackend = Trivial+-- class Trivial a+-- instance Trivial a  newtype SqlSyntaxM a = SqlSyntaxM (IO a)   deriving (Applicative, Functor, Monad, MonadIO, Fail.MonadFail)--instance MonadBeam SqlSyntaxBuilder SqlSyntaxBackend SqlSyntaxBackend SqlSyntaxM where-  withDatabaseDebug _ _ _ = Fail.fail "absurd"-  runReturningMany _ _ = Fail.fail "absurd"--

@@ -0,0 +1,200 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ConstraintKinds #-}++module Database.Beam.Backend.SQL.Row+  ( FromBackendRowF(..), FromBackendRowM(..)+  , parseOneField, peekField++  , ColumnParseError(..), BeamRowReadError(..)++  , FromBackendRow(..)+  ) where++import           Database.Beam.Backend.SQL.Types+import           Database.Beam.Backend.Types++import           Control.Applicative+import           Control.Exception (Exception)+import           Control.Monad.Free.Church+import           Control.Monad.Identity+import           Data.Tagged+import           Data.Typeable+import           Data.Vector.Sized (Vector)+import qualified Data.Vector.Sized as Vector++#if !MIN_VERSION_base(4, 12, 0)+import           Data.Proxy+#endif++import           GHC.Generics+import           GHC.TypeLits++-- | The exact error encountered+data ColumnParseError+  = ColumnUnexpectedNull+  | ColumnNotEnoughColumns !Int+  | ColumnTypeMismatch+  { ctmHaskellType :: String+  , ctmSQLType     :: String+  , ctmMessage     :: String+  }+  | ColumnErrorInternal String+  deriving (Show, Eq, Ord)++-- | An error that may occur when parsing a row. Contains an optional+-- annotation of which column was being parsed (if available).+data BeamRowReadError+  = BeamRowReadError+  { brreColumn :: !(Maybe Int)+  , brreError  :: !ColumnParseError+  } deriving (Show, Eq, Ord)+instance Exception BeamRowReadError++data FromBackendRowF be f where+  ParseOneField :: (BackendFromField be a, Typeable a) => (a -> f) -> FromBackendRowF be f+  Alt :: FromBackendRowM be a -> FromBackendRowM be a -> (a -> f) -> FromBackendRowF be f+  FailParseWith :: BeamRowReadError -> FromBackendRowF be f+deriving instance Functor (FromBackendRowF be)+newtype FromBackendRowM be a = FromBackendRowM (F (FromBackendRowF be) a)+  deriving (Functor, Applicative)++instance Monad (FromBackendRowM be) where+  return = pure+  FromBackendRowM a >>= b =+    FromBackendRowM $+    a >>= (\x -> let FromBackendRowM b' = b x in b')++  fail = FromBackendRowM . liftF . FailParseWith .+         BeamRowReadError Nothing . ColumnErrorInternal++instance Alternative (FromBackendRowM be) where+  empty   = fail "empty"+  a <|> b =+    FromBackendRowM (liftF (Alt a b id))++parseOneField :: (BackendFromField be a, Typeable a) => FromBackendRowM be a+parseOneField = do+  x <- FromBackendRowM (liftF (ParseOneField id))+  pure x++peekField :: (Typeable a, BackendFromField be a) => FromBackendRowM be (Maybe a)+peekField = fmap Just (FromBackendRowM (liftF (ParseOneField id))) <|> pure Nothing++-- BeamBackend instead of BeamSqlBackend to prevent circular super class+class BeamBackend be => FromBackendRow be a where+  -- | Parses a beam row. This should not fail, except in the case of+  -- an internal bug in beam deserialization code. If it does fail,+  -- this should throw a 'BeamRowParseError'.+  fromBackendRow :: FromBackendRowM be a+  default fromBackendRow :: (Typeable a, BackendFromField be a) => FromBackendRowM be a+  fromBackendRow = parseOneField++  valuesNeeded :: Proxy be -> Proxy a -> Int+  valuesNeeded _ _ = 1++class GFromBackendRow be (exposed :: * -> *) rep where+  gFromBackendRow :: Proxy exposed -> FromBackendRowM be (rep ())+  gValuesNeeded :: Proxy be -> Proxy exposed -> Proxy rep -> Int+instance GFromBackendRow be e p => GFromBackendRow be (M1 t f e) (M1 t f p) where+  gFromBackendRow _ = M1 <$> gFromBackendRow (Proxy @e)+  gValuesNeeded be _ _ = gValuesNeeded be (Proxy @e) (Proxy @p)+instance GFromBackendRow be e U1 where+  gFromBackendRow _ = pure U1+  gValuesNeeded _ _ _ = 0+instance (GFromBackendRow be aExp a, GFromBackendRow be bExp b) => GFromBackendRow be (aExp :*: bExp) (a :*: b) where+  gFromBackendRow _ = (:*:) <$> gFromBackendRow (Proxy @aExp) <*> gFromBackendRow (Proxy @bExp)+  gValuesNeeded be _ _ = gValuesNeeded be (Proxy @aExp) (Proxy @a) + gValuesNeeded be (Proxy @bExp) (Proxy @b)+instance FromBackendRow be x => GFromBackendRow be (K1 R (Exposed x)) (K1 R x) where+  gFromBackendRow _ = K1 <$> fromBackendRow+  gValuesNeeded be _ _ = valuesNeeded be (Proxy @x)+instance FromBackendRow be (t Identity) => GFromBackendRow be (K1 R (t Exposed)) (K1 R (t Identity)) where+    gFromBackendRow _ = K1 <$> fromBackendRow+    gValuesNeeded be _ _ = valuesNeeded be (Proxy @(t Identity))+instance FromBackendRow be (t (Nullable Identity)) => GFromBackendRow be (K1 R (t (Nullable Exposed))) (K1 R (t (Nullable Identity))) where+    gFromBackendRow _ = K1 <$> fromBackendRow+    gValuesNeeded be _ _ = valuesNeeded be (Proxy @(t (Nullable Identity)))+instance BeamBackend be => FromBackendRow be () where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep ()))+  valuesNeeded _ _ = 0++instance ( BeamBackend be, KnownNat n, FromBackendRow be a ) => FromBackendRow be (Vector n a) where+  fromBackendRow = Vector.replicateM fromBackendRow+  valuesNeeded _ _ = fromIntegral (natVal (Proxy @n))++instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b ) =>+  FromBackendRow be (a, b) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b)+instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b, FromBackendRow be c ) =>+  FromBackendRow be (a, b, c) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c)+instance ( BeamBackend be+         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c+         , FromBackendRow be d ) =>+  FromBackendRow be (a, b, c, d) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d)+instance ( BeamBackend be+         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c+         , FromBackendRow be d, FromBackendRow be e ) =>+  FromBackendRow be (a, b, c, d, e) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) ++                      valuesNeeded be (Proxy @e)+instance ( BeamBackend be+         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c+         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f ) =>+  FromBackendRow be (a, b, c, d, e, f) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) ++                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f)+instance ( BeamBackend be+         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c+         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f+         , FromBackendRow be g ) =>+  FromBackendRow be (a, b, c, d, e, f, g) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) ++                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f) + valuesNeeded be (Proxy @g)+instance ( BeamBackend be+         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c+         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f+         , FromBackendRow be g, FromBackendRow be h ) =>+  FromBackendRow be (a, b, c, d, e, f, g, h) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g, Exposed h)))+  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) ++                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f) + valuesNeeded be (Proxy @g) + valuesNeeded be (Proxy @h)++instance ( BeamBackend be, Generic (tbl Identity), Generic (tbl Exposed)+         , GFromBackendRow be (Rep (tbl Exposed)) (Rep (tbl Identity))) =>++    FromBackendRow be (tbl Identity) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (tbl Exposed)))+  valuesNeeded be _ = gValuesNeeded be (Proxy @(Rep (tbl Exposed))) (Proxy @(Rep (tbl Identity)))+instance ( BeamBackend be, Generic (tbl (Nullable Identity)), Generic (tbl (Nullable Exposed))+         , GFromBackendRow be (Rep (tbl (Nullable Exposed))) (Rep (tbl (Nullable Identity)))) =>++    FromBackendRow be (tbl (Nullable Identity)) where+  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (tbl (Nullable Exposed))))+  valuesNeeded be _ = gValuesNeeded be (Proxy @(Rep (tbl (Nullable Exposed)))) (Proxy @(Rep (tbl (Nullable Identity))))++instance (FromBackendRow be x, FromBackendRow be SqlNull) => FromBackendRow be (Maybe x) where+  fromBackendRow =+    (Just <$> fromBackendRow) <|>+    (Nothing <$+      replicateM_ (valuesNeeded (Proxy @be) (Proxy @(Maybe x)))+                  (do SqlNull <- fromBackendRow+                      pure ()))+  valuesNeeded be _ = valuesNeeded be (Proxy @x)++deriving instance Generic (a, b, c, d, e, f, g, h)++instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where+  fromBackendRow = Tagged <$> fromBackendRow++instance FromBackendRow be x => FromBackendRow be (SqlSerial x) where+  fromBackendRow = SqlSerial <$> fromBackendRow

@@ -20,15 +20,18 @@     , IsSql2003LeadAndLagExpressionSyntax(..)     , IsSql2008BigIntDataTypeSyntax(..) -    , Sql2003ExpressionSanityCheck+    , Sql2003SanityCheck     ) where  import Database.Beam.Backend.SQL.SQL99  import Data.Text (Text) -type Sql2003ExpressionSanityCheck syntax =-    ( syntax ~ Sql2003WindowFrameExpressionSyntax (Sql2003ExpressionWindowFrameSyntax syntax) )+type Sql2003SanityCheck syntax =+    ( Sql92ExpressionSyntax syntax ~ Sql2003WindowFrameExpressionSyntax (Sql2003ExpressionWindowFrameSyntax (Sql92ExpressionSyntax syntax))+    , Sql92SelectOrderingSyntax (Sql92SelectSyntax syntax) ~+      Sql2003WindowFrameOrderingSyntax (Sql2003ExpressionWindowFrameSyntax (Sql92ExpressionSyntax syntax))+    )  class IsSql92FromSyntax from =>     IsSql2003FromSyntax from where@@ -56,6 +59,7 @@     overE :: expr           -> Sql2003ExpressionWindowFrameSyntax expr           -> expr+    rowNumberE :: expr  -- | Optional SQL2003 "Advanced OLAP operations" T612 support class IsSql2003ExpressionSyntax expr =>

@@ -4,7 +4,7 @@ module Database.Beam.Backend.SQL.SQL92 where  import Database.Beam.Backend.SQL.Types-import Database.Beam.Backend.Types+import Database.Beam.Backend.SQL.Row  import Data.Int import Data.Tagged@@ -12,14 +12,10 @@ import Data.Time (LocalTime) import Data.Typeable -class ( BeamSqlBackend be ) =>-      BeamSql92Backend be where- -- * Finally tagless style  class HasSqlValueSyntax expr ty where   sqlValueSyntax :: ty -> expr-class IsSqlExpressionSyntaxStringType expr ty  autoSqlValueSyntax :: (HasSqlValueSyntax expr String, Show a) => a -> expr autoSqlValueSyntax = sqlValueSyntax . show@@ -29,9 +25,11 @@ type Sql92SelectGroupingSyntax select = Sql92SelectTableGroupingSyntax (Sql92SelectSelectTableSyntax select) type Sql92SelectFromSyntax select = Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select) type Sql92InsertExpressionSyntax select = Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax select)+type Sql92TableNameSyntax select = Sql92TableSourceTableNameSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax select))  type Sql92ValueSyntax cmdSyntax = Sql92ExpressionValueSyntax (Sql92ExpressionSyntax cmdSyntax) type Sql92ExpressionSyntax cmdSyntax = Sql92SelectExpressionSyntax (Sql92SelectSyntax cmdSyntax)+type Sql92ExtractFieldSyntax cmdSyntax = Sql92ExpressionExtractFieldSyntax (Sql92ExpressionSyntax cmdSyntax) type Sql92HasValueSyntax cmdSyntax = HasSqlValueSyntax (Sql92ValueSyntax cmdSyntax)  -- Putting these in the head constraint can cause infinite recursion that would@@ -44,14 +42,34 @@   , Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax select)) ~     Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)   , Sql92OrderingExpressionSyntax (Sql92SelectOrderingSyntax select) ~+    Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)+  , Sql92TableSourceExpressionSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))) ~     Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))-type Sql92SanityCheck cmd = ( Sql92SelectSanityCheck (Sql92SelectSyntax cmd)-                            , Sql92ExpressionValueSyntax (Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd))) ~ Sql92ValueSyntax cmd-                            , Sql92ExpressionValueSyntax (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax cmd)) ~ Sql92ValueSyntax cmd-                            , Sql92ExpressionValueSyntax (Sql92DeleteExpressionSyntax (Sql92DeleteSyntax cmd)) ~ Sql92ValueSyntax cmd-                            , Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax (Sql92SelectSyntax cmd)) ~-                              Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd)) )+type Sql92SanityCheck cmd =+  ( Sql92SelectSanityCheck (Sql92SelectSyntax cmd)+  , Sql92ExpressionValueSyntax (Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd))) ~ Sql92ValueSyntax cmd+  , Sql92ExpressionValueSyntax (Sql92UpdateExpressionSyntax (Sql92UpdateSyntax cmd)) ~ Sql92ValueSyntax cmd+  , Sql92ExpressionValueSyntax (Sql92DeleteExpressionSyntax (Sql92DeleteSyntax cmd)) ~ Sql92ValueSyntax cmd +  , Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax (Sql92SelectSyntax cmd)) ~+    Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd))++  , Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax (Sql92SelectSyntax cmd)) ~+    Sql92UpdateExpressionSyntax (Sql92UpdateSyntax cmd)++  , Sql92DeleteExpressionSyntax (Sql92DeleteSyntax cmd) ~+    Sql92UpdateExpressionSyntax (Sql92UpdateSyntax cmd)++  , Sql92ExpressionSelectSyntax (Sql92InsertExpressionSyntax (Sql92InsertSyntax cmd)) ~+    Sql92SelectSyntax cmd++  , Sql92InsertValuesSelectSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd)) ~+    Sql92SelectSyntax cmd++  , Sql92UpdateFieldNameSyntax (Sql92UpdateSyntax cmd) ~+    Sql92ExpressionFieldNameSyntax (Sql92InsertValuesExpressionSyntax (Sql92InsertValuesSyntax (Sql92InsertSyntax cmd)))+  )+ type Sql92ReasonableMarshaller be =    ( FromBackendRow be Int, FromBackendRow be SqlNull    , FromBackendRow be Text, FromBackendRow be Bool@@ -59,6 +77,13 @@    , FromBackendRow be Int16, FromBackendRow be Int32, FromBackendRow be Int64    , FromBackendRow be LocalTime ) +-- | Type classes for syntaxes which can be displayed+class Sql92DisplaySyntax syntax where++  -- | Render the syntax as a 'String', representing the SQL expression it+  -- stands for+  displaySyntax :: syntax -> String+ class ( IsSql92SelectSyntax (Sql92SelectSyntax cmd)       , IsSql92InsertSyntax (Sql92InsertSyntax cmd)       , IsSql92UpdateSyntax (Sql92UpdateSyntax cmd)@@ -117,12 +142,16 @@   unionTables, intersectTables, exceptTable ::     Bool -> select -> select -> select -class IsSql92InsertValuesSyntax (Sql92InsertValuesSyntax insert) =>+class ( IsSql92InsertValuesSyntax (Sql92InsertValuesSyntax insert)+      , IsSql92TableNameSyntax (Sql92InsertTableNameSyntax insert) ) =>   IsSql92InsertSyntax insert where    type Sql92InsertValuesSyntax insert :: *-  insertStmt :: Text+  type Sql92InsertTableNameSyntax insert :: *++  insertStmt :: Sql92InsertTableNameSyntax insert              -> [ Text ]+             -- ^ Fields              -> Sql92InsertValuesSyntax insert              -> insert @@ -137,21 +166,26 @@                 -> insertValues  class ( IsSql92ExpressionSyntax (Sql92UpdateExpressionSyntax update)-      , IsSql92FieldNameSyntax (Sql92UpdateFieldNameSyntax update)) =>+      , IsSql92FieldNameSyntax (Sql92UpdateFieldNameSyntax update)+      , IsSql92TableNameSyntax (Sql92UpdateTableNameSyntax update) ) =>       IsSql92UpdateSyntax update where++  type Sql92UpdateTableNameSyntax update :: *   type Sql92UpdateFieldNameSyntax update :: *   type Sql92UpdateExpressionSyntax update :: * -  updateStmt :: Text+  updateStmt :: Sql92UpdateTableNameSyntax update              -> [(Sql92UpdateFieldNameSyntax update, Sql92UpdateExpressionSyntax update)]              -> Maybe (Sql92UpdateExpressionSyntax update) {-^ WHERE -}              -> update -class IsSql92ExpressionSyntax (Sql92DeleteExpressionSyntax delete) =>+class ( IsSql92TableNameSyntax (Sql92DeleteTableNameSyntax delete)+      , IsSql92ExpressionSyntax (Sql92DeleteExpressionSyntax delete) ) =>   IsSql92DeleteSyntax delete where+  type Sql92DeleteTableNameSyntax delete :: *   type Sql92DeleteExpressionSyntax delete :: * -  deleteStmt :: Text -> Maybe Text+  deleteStmt :: Sql92DeleteTableNameSyntax delete -> Maybe Text              -> Maybe (Sql92DeleteExpressionSyntax delete)              -> delete @@ -166,6 +200,14 @@ class IsSql92QuantifierSyntax quantifier where   quantifyOverAll, quantifyOverAny :: quantifier +class IsSql92ExtractFieldSyntax extractField where+  secondsField :: extractField+  minutesField :: extractField+  hourField :: extractField+  dayField :: extractField+  monthField :: extractField+  yearField :: extractField+ class IsSql92DataTypeSyntax dataType where   domainType :: Text -> dataType   charType :: Maybe Word -> Maybe Text -> dataType@@ -191,6 +233,8 @@       , HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Bool       , IsSql92FieldNameSyntax (Sql92ExpressionFieldNameSyntax expr)       , IsSql92QuantifierSyntax (Sql92ExpressionQuantifierSyntax expr)+      , IsSql92DataTypeSyntax (Sql92ExpressionCastTargetSyntax expr)+      , IsSql92ExtractFieldSyntax (Sql92ExpressionExtractFieldSyntax expr)       , Typeable expr ) =>     IsSql92ExpressionSyntax expr where   type Sql92ExpressionQuantifierSyntax expr :: *@@ -210,6 +254,8 @@   fieldE :: Sql92ExpressionFieldNameSyntax expr -> expr    betweenE :: expr -> expr -> expr -> expr+  betweenE a lower upper =+    (gtE Nothing a lower) `andE` (ltE Nothing a upper)    andE, orE, addE, subE, mulE, divE, likeE,     modE, overlapsE, nullIfE, positionE@@ -295,10 +341,22 @@   ascOrdering, descOrdering     :: Sql92OrderingExpressionSyntax ord -> ord -class IsSql92TableSourceSyntax tblSource where+class IsSql92TableNameSyntax tblName where+  tableName :: Maybe Text {-^ Schema -}+            -> Text {-^ Table name -}+            -> tblName++class IsSql92TableNameSyntax (Sql92TableSourceTableNameSyntax tblSource) =>+  IsSql92TableSourceSyntax tblSource where+   type Sql92TableSourceSelectSyntax tblSource :: *-  tableNamed :: Text -> tblSource+  type Sql92TableSourceExpressionSyntax tblSource :: *+  type Sql92TableSourceTableNameSyntax tblSource :: *++  tableNamed :: Sql92TableSourceTableNameSyntax tblSource+             -> tblSource   tableFromSubSelect :: Sql92TableSourceSelectSyntax tblSource -> tblSource+  tableFromValues :: [ [ Sql92TableSourceExpressionSyntax tblSource ] ] -> tblSource  class IsSql92GroupingSyntax grouping where   type Sql92GroupingExpressionSyntax grouping :: *@@ -312,7 +370,7 @@   type Sql92FromExpressionSyntax from :: *    fromTable :: Sql92FromTableSourceSyntax from-            -> Maybe Text+            -> Maybe (Text, Maybe [Text])             -> from    innerJoin, leftJoin, rightJoin@@ -330,4 +388,3 @@ instance HasSqlValueSyntax vs t => HasSqlValueSyntax vs (Tagged tag t) where   sqlValueSyntax = sqlValueSyntax . untag -instance IsSqlExpressionSyntaxStringType e t => IsSqlExpressionSyntaxStringType e (Tagged tag t)

@@ -3,9 +3,13 @@ -- | Finally tagless extension of SQL92 syntaxes for SQL99 module Database.Beam.Backend.SQL.SQL99   ( module Database.Beam.Backend.SQL.SQL92+  , IsSql99FunctionExpressionSyntax(..)   , IsSql99ExpressionSyntax(..)   , IsSql99ConcatExpressionSyntax(..)   , IsSql99AggregationExpressionSyntax(..)+  , IsSql99CommonTableExpressionSelectSyntax(..)+  , IsSql99CommonTableExpressionSyntax(..)+  , IsSql99RecursiveCommonTableExpressionSelectSyntax(..)   , IsSql99SelectSyntax(..)   , IsSql99DataTypeSyntax(..) ) where @@ -17,13 +21,17 @@   IsSql99SelectSyntax select  class IsSql92ExpressionSyntax expr =>+  IsSql99FunctionExpressionSyntax expr where++  functionCallE :: expr -> [ expr ] -> expr+  functionNameE :: Text -> expr++class IsSql99FunctionExpressionSyntax expr =>   IsSql99ExpressionSyntax expr where    distinctE :: Sql92ExpressionSelectSyntax expr -> expr   similarToE :: expr -> expr -> expr -  functionCallE :: expr -> [ expr ] -> expr-   instanceFieldE :: expr -> Text -> expr   refFieldE :: expr -> Text -> expr @@ -42,3 +50,19 @@   booleanType :: dataType   arrayType :: dataType -> Int -> dataType   rowType :: [ (Text, dataType) ] -> dataType++class IsSql92SelectSyntax syntax =>+  IsSql99CommonTableExpressionSelectSyntax syntax where+  type Sql99SelectCTESyntax syntax :: *++  withSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax++class IsSql99CommonTableExpressionSelectSyntax syntax+    => IsSql99RecursiveCommonTableExpressionSelectSyntax syntax where++  withRecursiveSyntax :: [ Sql99SelectCTESyntax syntax ] -> syntax -> syntax++class IsSql99CommonTableExpressionSyntax syntax where+  type Sql99CTESelectSyntax syntax :: *++  cteSubquerySyntax :: Text -> [Text] -> Sql99CTESelectSyntax syntax -> syntax

@@ -1,14 +1,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Database.Beam.Backend.SQL.Types where -import Database.Beam.Backend.Types- import qualified Data.Aeson as Json import           Data.Bits -class ( BeamBackend be ) =>-      BeamSqlBackend be where- data SqlNull = SqlNull   deriving (Show, Eq, Ord, Bounded, Enum) newtype SqlBitString = SqlBitString Integer@@ -16,8 +11,7 @@  newtype SqlSerial a = SqlSerial { unSerial :: a }   deriving (Show, Read, Eq, Ord, Num, Integral, Real, Enum)-instance FromBackendRow be x => FromBackendRow be (SqlSerial x) where-  fromBackendRow = SqlSerial <$> fromBackendRow+ instance Json.FromJSON a => Json.FromJSON (SqlSerial a) where   parseJSON a = SqlSerial <$> Json.parseJSON a instance Json.ToJSON a => Json.ToJSON (SqlSerial a) where

@@ -1,59 +1,19 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ConstraintKinds #-}  module Database.Beam.Backend.Types   ( BeamBackend(..) -  , FromBackendRowF(..), FromBackendRowM-  , parseOneField, peekField, checkNextNNull--  , FromBackendRow(..)--  , Exposed, Nullable ) where--import           Control.Monad.Free.Church-import           Control.Monad.Identity-import           Data.Tagged-import           Data.Vector.Sized (Vector)-import qualified Data.Vector.Sized as Vector+  , Exposed, Nullable -import Data.Proxy+  ) where -import GHC.Generics-import GHC.TypeLits-import GHC.Types+import           GHC.Types --- | Class for all beam backends+-- | Class for all Beam backends class BeamBackend be where   -- | Requirements to marshal a certain type from a database of a particular backend   type BackendFromField be :: * -> Constraint -data FromBackendRowF be f where-  ParseOneField :: BackendFromField be a => (a -> f) -> FromBackendRowF be f-  PeekField :: BackendFromField be a => (Maybe a -> f) -> FromBackendRowF be f-  CheckNextNNull :: Int -> (Bool -> f) -> FromBackendRowF be f-deriving instance Functor (FromBackendRowF be)-type FromBackendRowM be = F (FromBackendRowF be)--parseOneField :: BackendFromField be a => FromBackendRowM be a-parseOneField = liftF (ParseOneField id)--peekField :: BackendFromField be a => FromBackendRowM be (Maybe a)-peekField = liftF (PeekField id)--checkNextNNull :: Int -> FromBackendRowM be Bool-checkNextNNull n = liftF (CheckNextNNull n id)--class BeamBackend be => FromBackendRow be a where-  fromBackendRow :: FromBackendRowM be a-  default fromBackendRow :: BackendFromField be a => FromBackendRowM be a-  fromBackendRow = parseOneField--  valuesNeeded :: Proxy be -> Proxy a -> Int-  valuesNeeded _ _ = 1- -- | newtype mainly used to inspect the tag structure of a particular --   'Beamable'. Prevents overlapping instances in some case. Usually not used --   in end-user code.@@ -68,103 +28,3 @@ -- -- See 'Columnar' for more information. data Nullable (c :: * -> *) x--class GFromBackendRow be (exposed :: * -> *) rep where-  gFromBackendRow :: Proxy exposed -> FromBackendRowM be (rep ())-  gValuesNeeded :: Proxy be -> Proxy exposed -> Proxy rep -> Int-instance GFromBackendRow be e p => GFromBackendRow be (M1 t f e) (M1 t f p) where-  gFromBackendRow _ = M1 <$> gFromBackendRow (Proxy @e)-  gValuesNeeded be _ _ = gValuesNeeded be (Proxy @e) (Proxy @p)-instance GFromBackendRow be e U1 where-  gFromBackendRow _ = pure U1-  gValuesNeeded _ _ _ = 0-instance (GFromBackendRow be aExp a, GFromBackendRow be bExp b) => GFromBackendRow be (aExp :*: bExp) (a :*: b) where-  gFromBackendRow _ = (:*:) <$> gFromBackendRow (Proxy @aExp) <*> gFromBackendRow (Proxy @bExp)-  gValuesNeeded be _ _ = gValuesNeeded be (Proxy @aExp) (Proxy @a) + gValuesNeeded be (Proxy @bExp) (Proxy @b)-instance FromBackendRow be x => GFromBackendRow be (K1 R (Exposed x)) (K1 R x) where-  gFromBackendRow _ = K1 <$> fromBackendRow-  gValuesNeeded be _ _ = valuesNeeded be (Proxy @x)-instance FromBackendRow be (t Identity) => GFromBackendRow be (K1 R (t Exposed)) (K1 R (t Identity)) where-    gFromBackendRow _ = K1 <$> fromBackendRow-    gValuesNeeded be _ _ = valuesNeeded be (Proxy @(t Identity))-instance FromBackendRow be (t (Nullable Identity)) => GFromBackendRow be (K1 R (t (Nullable Exposed))) (K1 R (t (Nullable Identity))) where-    gFromBackendRow _ = K1 <$> fromBackendRow-    gValuesNeeded be _ _ = valuesNeeded be (Proxy @(t (Nullable Identity)))-instance BeamBackend be => FromBackendRow be () where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep ()))-  valuesNeeded _ _ = 0--instance ( BeamBackend be, KnownNat n, FromBackendRow be a ) => FromBackendRow be (Vector n a) where-  fromBackendRow = Vector.replicateM fromBackendRow-  valuesNeeded _ _ = fromIntegral (natVal (Proxy @n))--instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b ) =>-  FromBackendRow be (a, b) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b)-instance ( BeamBackend be, FromBackendRow be a, FromBackendRow be b, FromBackendRow be c ) =>-  FromBackendRow be (a, b, c) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c)-instance ( BeamBackend be-         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c-         , FromBackendRow be d ) =>-  FromBackendRow be (a, b, c, d) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d)-instance ( BeamBackend be-         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c-         , FromBackendRow be d, FromBackendRow be e ) =>-  FromBackendRow be (a, b, c, d, e) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) +-                      valuesNeeded be (Proxy @e)-instance ( BeamBackend be-         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c-         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f ) =>-  FromBackendRow be (a, b, c, d, e, f) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) +-                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f)-instance ( BeamBackend be-         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c-         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f-         , FromBackendRow be g ) =>-  FromBackendRow be (a, b, c, d, e, f, g) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) +-                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f) + valuesNeeded be (Proxy @g)-instance ( BeamBackend be-         , FromBackendRow be a, FromBackendRow be b, FromBackendRow be c-         , FromBackendRow be d, FromBackendRow be e, FromBackendRow be f-         , FromBackendRow be g, FromBackendRow be h ) =>-  FromBackendRow be (a, b, c, d, e, f, g, h) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (Exposed a, Exposed b, Exposed c, Exposed d, Exposed e, Exposed f, Exposed g, Exposed h)))-  valuesNeeded be _ = valuesNeeded be (Proxy @a) + valuesNeeded be (Proxy @b) + valuesNeeded be (Proxy @c) + valuesNeeded be (Proxy @d) +-                      valuesNeeded be (Proxy @e) + valuesNeeded be (Proxy @f) + valuesNeeded be (Proxy @g) + valuesNeeded be (Proxy @h)--instance ( BeamBackend be, Generic (tbl Identity), Generic (tbl Exposed)-         , GFromBackendRow be (Rep (tbl Exposed)) (Rep (tbl Identity))) =>--    FromBackendRow be (tbl Identity) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (tbl Exposed)))-  valuesNeeded be _ = gValuesNeeded be (Proxy @(Rep (tbl Exposed))) (Proxy @(Rep (tbl Identity)))-instance ( BeamBackend be, Generic (tbl (Nullable Identity)), Generic (tbl (Nullable Exposed))-         , GFromBackendRow be (Rep (tbl (Nullable Exposed))) (Rep (tbl (Nullable Identity)))) =>--    FromBackendRow be (tbl (Nullable Identity)) where-  fromBackendRow = to <$> gFromBackendRow (Proxy @(Rep (tbl (Nullable Exposed))))-  valuesNeeded be _ = gValuesNeeded be (Proxy @(Rep (tbl (Nullable Exposed)))) (Proxy @(Rep (tbl (Nullable Identity))))--instance FromBackendRow be x => FromBackendRow be (Maybe x) where-  fromBackendRow =-    do isNull <- checkNextNNull (valuesNeeded (Proxy @be) (Proxy @(Maybe x)))-       if isNull then pure Nothing else Just <$> fromBackendRow-  valuesNeeded be _ = valuesNeeded be (Proxy @x)--deriving instance Generic (a, b, c, d, e, f, g, h)---- Tagged--instance (BeamBackend be, FromBackendRow be t) => FromBackendRow be (Tagged tag t) where-  fromBackendRow = Tagged <$> fromBackendRow

@@ -3,8 +3,6 @@ -- | Convenience methods for constructing backend-agnostic applications module Database.Beam.Backend.URI where -import           Database.Beam.Backend.SQL- import           Control.Exception  import qualified Data.Map as M@@ -24,8 +22,8 @@ instance Exception BeamOpenURIUnsupportedScheme  data BeamURIOpener c where-  BeamURIOpener :: MonadBeam syntax be hdl m-                => c syntax be hdl m+  BeamURIOpener :: c be hdl m+                -> (forall a. hdl -> m a -> IO a)                 -> (URI -> IO (hdl, IO ()))                 -> BeamURIOpener c newtype BeamURIOpeners c where@@ -41,45 +39,45 @@  data OpenedBeamConnection c where   OpenedBeamConnection-    :: MonadBeam syntax be hdl m-    => { openedBeamDatabase :: c syntax be hdl m-       , openedBeamHandle   :: hdl+    :: { beamRunner          :: (forall a. hdl -> m a -> IO a)+       , openedBeamDatabase  :: c be hdl m+       , openedBeamHandle    :: hdl        , closeBeamConnection :: IO ()      } -> OpenedBeamConnection c -mkUriOpener :: MonadBeam syntax be hdl m-            => String+mkUriOpener :: (forall a. hdl -> m a -> IO a)+            -> String             -> (URI -> IO (hdl, IO ()))-            -> c syntax be hdl m+            -> c be hdl m             -> BeamURIOpeners c-mkUriOpener schemeNm opener c = BeamURIOpeners (M.singleton schemeNm (BeamURIOpener c opener))+mkUriOpener runner schemeNm opener c = BeamURIOpeners (M.singleton schemeNm (BeamURIOpener c runner opener))  withDbFromUri :: forall c a                . BeamURIOpeners c               -> String-              -> (forall syntax be hdl m. MonadBeam syntax be hdl m => c syntax be hdl m -> m a)+              -> (forall be hdl m. (forall r. hdl -> m r -> IO r) -> c be hdl m -> m a)               -> IO a withDbFromUri protos uri actionWithDb =-  withDbConnection protos uri (\c hdl -> withDatabase hdl (actionWithDb c))+  withDbConnection protos uri (\runner c hdl -> runner hdl (actionWithDb runner c))  withDbConnection :: forall c a                   . BeamURIOpeners c                  -> String-                 -> (forall syntax be hdl m. MonadBeam syntax be hdl m =>-                      c syntax be hdl m -> hdl -> IO a)+                 -> (forall be hdl m. (forall r. hdl -> m r -> IO r) ->+                      c be hdl m -> hdl -> IO a)                  -> IO a withDbConnection protos uri actionWithDb =   bracket (openDbConnection protos uri) closeBeamConnection $-  \(OpenedBeamConnection c hdl _) -> actionWithDb c hdl+  \(OpenedBeamConnection runner c hdl _) -> actionWithDb runner c hdl  openDbConnection :: forall c                   . BeamURIOpeners c                  -> String                  -> IO (OpenedBeamConnection c) openDbConnection protos uri = do-  (parsedUri, BeamURIOpener c openURI) <- findURIOpener protos uri+  (parsedUri, BeamURIOpener c runner openURI) <- findURIOpener protos uri   (hdl, closeHdl) <- openURI parsedUri-  pure (OpenedBeamConnection c hdl closeHdl)+  pure (OpenedBeamConnection runner c hdl closeHdl)  findURIOpener :: BeamURIOpeners c -> String -> IO (URI, BeamURIOpener c) findURIOpener (BeamURIOpeners protos) uri =

@@ -13,15 +13,21 @@     , QAggregateContext, QGroupingContext, QValueContext     , QWindowingContext, QWindowFrameContext -    , QueryableSqlSyntax-     , QGenExprTable, QExprTable +    , QAssignment, QField, QFieldAssignment++    , QBaseScope+     , module Database.Beam.Query.Combinators     , module Database.Beam.Query.Extensions      , module Database.Beam.Query.Relationships +    , module Database.Beam.Query.CTE++    , module Database.Beam.Query.Extract+     -- * Operators     , module Database.Beam.Query.Operator @@ -31,6 +37,8 @@     , isFalse_, isNotFalse_     , isUnknown_, isNotUnknown_     , unknownAs_, sqlBool_+    , possiblyNullBool_+    , fromPossiblyNullBool_      -- ** Unquantified comparison operators     , HasSqlEqualityCheck(..), HasSqlQuantifiedEqualityCheck(..)@@ -47,10 +55,12 @@      , module Database.Beam.Query.CustomSQL +    , module Database.Beam.Query.DataTypes+     -- * SQL Command construction and execution     -- ** @SELECT@     , SqlSelect(..)-    , select, lookup_+    , select, selectWith, lookup_     , runSelectReturningList     , runSelectReturningOne     , dumpSqlSelect@@ -69,6 +79,10 @@     -- ** @UPDATE@     , SqlUpdate(..)     , update, save+    , updateTable, set, setFieldsTo+    , toNewValue, toOldValue, toUpdatedValue+    , toUpdatedValueMaybe+    , updateRow, updateTableRow     , runUpdate      -- ** @DELETE@@@ -80,8 +94,12 @@  import Database.Beam.Query.Aggregate import Database.Beam.Query.Combinators+import Database.Beam.Query.CTE ( With, ReusableQ, selecting, reuse )+import qualified Database.Beam.Query.CTE as CTE import Database.Beam.Query.CustomSQL+import Database.Beam.Query.DataTypes import Database.Beam.Query.Extensions+import Database.Beam.Query.Extract import Database.Beam.Query.Internal import Database.Beam.Query.Operator hiding (SqlBool) import qualified Database.Beam.Query.Operator as Beam@@ -90,63 +108,68 @@ import Database.Beam.Query.Types (QGenExpr) -- hide QGenExpr constructor import Database.Beam.Query.Types hiding (QGenExpr) -import Database.Beam.Backend.Types import Database.Beam.Backend.SQL import Database.Beam.Backend.SQL.Builder import Database.Beam.Schema.Tables  import Control.Monad.Identity import Control.Monad.Writer+import Control.Monad.State.Strict +import Data.Functor.Const (Const(..)) import Data.Text (Text) import Data.Proxy +import Lens.Micro ((^.))+ -- * Query -data QueryInaccessible+data QBaseScope  -- | A version of the table where each field is a 'QGenExpr'-type QGenExprTable ctxt syntax s tbl = tbl (QGenExpr ctxt syntax s)+type QGenExprTable ctxt be s tbl = tbl (QGenExpr ctxt be s) -type QExprTable syntax s tbl = QGenExprTable QValueContext syntax s tbl+type QExprTable be s tbl = QGenExprTable QValueContext be s tbl  -- * SELECT --- | Represents a select statement over the syntax 'select' that will return---   rows of type 'a'.-newtype SqlSelect select a-    = SqlSelect select--type QueryableSqlSyntax cmd =-  ( IsSql92Syntax cmd-  , Sql92SanityCheck cmd-  , HasQBuilder (Sql92SelectSyntax cmd) )+-- | Represents a select statement in the given backend, returning+-- rows of type 'a'.+newtype SqlSelect be a+    = SqlSelect (BeamSqlBackendSelectSyntax be)  -- | Build a 'SqlSelect' for the given 'Q'.-select :: forall syntax db res.-          ( ProjectibleInSelectSyntax syntax res-          , IsSql92SelectSyntax syntax-          , HasQBuilder syntax ) =>-          Q syntax db QueryInaccessible res -> SqlSelect syntax (QExprToIdentity res)+select :: forall be db res+        . ( BeamSqlBackend be, HasQBuilder be, Projectible be res )+       => Q be db QBaseScope res -> SqlSelect be (QExprToIdentity res) select q =   SqlSelect (buildSqlQuery "t" q) +-- | Create a 'SqlSelect' for a query which may have common table+-- expressions. See the documentation of 'With' for more details.+selectWith :: forall be db res+            . ( BeamSqlBackend be, BeamSql99CommonTableExpressionBackend be+              , HasQBuilder be, Projectible be res )+           => With be db (Q be db QBaseScope res) -> SqlSelect be (QExprToIdentity res)+selectWith (CTE.With mkQ) =+    let (q, (recursiveness, ctes)) = evalState (runWriterT mkQ) 0+    in case recursiveness of+         CTE.Nonrecursive -> SqlSelect (withSyntax ctes+                                                   (buildSqlQuery "t" q))+         CTE.Recursive    -> SqlSelect (withRecursiveSyntax ctes+                                                            (buildSqlQuery "t" q))+ -- | Convenience function to generate a 'SqlSelect' that looks up a table row --   given a primary key.-lookup_ :: ( HasQBuilder syntax-           , Sql92SelectSanityCheck syntax--           , SqlValableTable (PrimaryKey table) (Sql92SelectExpressionSyntax syntax)-           , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool--           , HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey table)--           , Beamable table, Table table+lookup_ :: ( Database be db, Table table -           , Database be db )+           , BeamSqlBackend be, HasQBuilder be+           , SqlValableTable be (PrimaryKey table)+           , HasTableEquality be (PrimaryKey table)+           )         => DatabaseEntity be db (TableEntity table)         -> PrimaryKey table Identity-        -> SqlSelect syntax (table Identity)+        -> SqlSelect be (table Identity) lookup_ tbl tblKey =   select $   filter_ (\t -> pk t ==. val_ tblKey) $@@ -154,8 +177,8 @@  -- | Run a 'SqlSelect' in a 'MonadBeam' and get the results as a list runSelectReturningList ::-  (IsSql92Syntax cmd, MonadBeam cmd be hdl m, FromBackendRow be a) =>-  SqlSelect (Sql92SelectSyntax cmd) a -> m [ a ]+  (MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>+  SqlSelect be a -> m [ a ] runSelectReturningList (SqlSelect s) =   runReturningList (selectCmd s) @@ -163,15 +186,15 @@ --   one. Both no results as well as more than one result cause this to return --   'Nothing'. runSelectReturningOne ::-  (IsSql92Syntax cmd, MonadBeam cmd be hdl m, FromBackendRow be a) =>-  SqlSelect (Sql92SelectSyntax cmd) a -> m (Maybe a)+  (MonadBeam be m, BeamSqlBackend be, FromBackendRow be a) =>+  SqlSelect be a -> m (Maybe a) runSelectReturningOne (SqlSelect s) =   runReturningOne (selectCmd s)  -- | Use a special debug syntax to print out an ANSI Standard @SELECT@ statement --   that may be generated for a given 'Q'.-dumpSqlSelect :: ProjectibleInSelectSyntax SqlSyntaxBuilder res =>-                 Q SqlSyntaxBuilder db QueryInaccessible res -> IO ()+dumpSqlSelect :: Projectible (MockSqlBackend SqlSyntaxBuilder) res+              => Q (MockSqlBackend SqlSyntaxBuilder) db QBaseScope res -> IO () dumpSqlSelect q =     let SqlSelect s = select q     in putStrLn (renderSql s)@@ -179,54 +202,54 @@ -- * INSERT  -- | Represents a SQL @INSERT@ command that has not yet been run-data SqlInsert syntax-  = SqlInsert syntax+data SqlInsert be (table :: (* -> *) -> *)+  = SqlInsert !(TableSettings table) !(BeamSqlBackendInsertSyntax be)   | SqlInsertNoRows  -- | Generate a 'SqlInsert' over only certain fields of a table-insertOnly :: ( IsSql92InsertSyntax syntax, Projectible Text (QExprToField r) )+insertOnly :: ( BeamSqlBackend be, ProjectibleWithPredicate AnyType () Text (QExprToField r) )            => DatabaseEntity be db (TableEntity table)               -- ^ Table to insert into            -> (table (QField s) -> QExprToField r)-           -> SqlInsertValues (Sql92InsertValuesSyntax syntax) r+           -> SqlInsertValues be r               -- ^ Values to insert. See 'insertValues', 'insertExpressions', 'insertData', and 'insertFrom' for possibilities.-           -> SqlInsert syntax+           -> SqlInsert be table insertOnly _ _ SqlInsertValuesEmpty = SqlInsertNoRows-insertOnly (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkProj (SqlInsertValues vs) =-    SqlInsert (insertStmt tblNm proj vs)+insertOnly (DatabaseEntity dt@(DatabaseTable {})) mkProj (SqlInsertValues vs) =+    SqlInsert (dbTableSettings dt) (insertStmt (tableNameFromEntity dt) proj vs)   where-    tblFields = changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QField False tblNm name)) tblSettings-    proj = execWriter (project' (Proxy @AnyType) (\_ f -> tell [f ""] >> pure f)+    tblFields = changeBeamRep (\(Columnar' fd) -> Columnar' (QField False (dbTableCurrentName dt) (fd ^. fieldName)))+                              (dbTableSettings dt)+    proj = execWriter (project' (Proxy @AnyType) (Proxy @((), Text))+                                (\_ _ f -> tell [f] >> pure f)                                 (mkProj tblFields))  -- | Generate a 'SqlInsert' given a table and a source of values.-insert :: ( IsSql92InsertSyntax syntax, Projectible Text (table (QField s)) )+insert :: ( BeamSqlBackend be, ProjectibleWithPredicate AnyType () Text (table (QField s)) )        => DatabaseEntity be db (TableEntity table)           -- ^ Table to insert into-       -> SqlInsertValues (Sql92InsertValuesSyntax syntax) (table (QExpr (Sql92InsertExpressionSyntax syntax) s))+       -> SqlInsertValues be (table (QExpr be s))           -- ^ Values to insert. See 'insertValues', 'insertExpressions', and 'insertFrom' for possibilities.-       -> SqlInsert syntax+       -> SqlInsert be table insert tbl values = insertOnly tbl id values  -- | Run a 'SqlInsert' in a 'MonadBeam'-runInsert :: (IsSql92Syntax cmd, MonadBeam cmd be hdl m)-          => SqlInsert (Sql92InsertSyntax cmd) -> m ()+runInsert :: (BeamSqlBackend be, MonadBeam be m)+          => SqlInsert be table -> m () runInsert SqlInsertNoRows = pure ()-runInsert (SqlInsert i) = runNoReturn (insertCmd i)+runInsert (SqlInsert _ i) = runNoReturn (insertCmd i)  -- | Represents a source of values that can be inserted into a table shaped like --   'tbl'.-data SqlInsertValues insertValues proj --(tbl :: (* -> *) -> *)-    = SqlInsertValues insertValues+data SqlInsertValues be proj --(tbl :: (* -> *) -> *)+    = SqlInsertValues (BeamSqlBackendInsertValuesSyntax be)     | SqlInsertValuesEmpty  -- | Build a 'SqlInsertValues' from series of expressions in tables-insertExpressions ::-    forall syntax table s.-    ( Beamable table-    , IsSql92InsertValuesSyntax syntax ) =>-    (forall s'. [ table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') ]) ->-    SqlInsertValues syntax (table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s))+insertExpressions :: forall be table s+                   . ( BeamSqlBackend be, Beamable table )+                  => (forall s'. [ table (QExpr be s') ])+                  -> SqlInsertValues be (table (QExpr be s)) insertExpressions tbls =   case sqlExprs of     [] -> SqlInsertValuesEmpty@@ -234,45 +257,38 @@     where       sqlExprs = map mkSqlExprs tbls -      mkSqlExprs :: forall s'. table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') -> [Sql92InsertValuesExpressionSyntax syntax]+      mkSqlExprs :: forall s'. table (QExpr be s') -> [ BeamSqlBackendExpressionSyntax be ]       mkSqlExprs = allBeamValues (\(Columnar' (QExpr x)) -> x "t")  -- | Build a 'SqlInsertValues' from concrete table values-insertValues ::-    forall table syntax s.-    ( Beamable table-    , IsSql92InsertValuesSyntax syntax-    , FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92InsertValuesExpressionSyntax syntax))) table) =>-    [ table Identity ] -> SqlInsertValues syntax (table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s))-insertValues x = insertExpressions (map val_ x :: forall s'. [table (QExpr (Sql92InsertValuesExpressionSyntax syntax) s') ])+insertValues :: forall be table s+              . ( BeamSqlBackend be, Beamable table+                , FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table )+             => [ table Identity ]+             -> SqlInsertValues be (table (QExpr be s))+insertValues x = insertExpressions (map val_ x :: forall s'. [table (QExpr be s') ])  -- | Build a 'SqlInsertValues' from arbitrarily shaped data containing expressions-insertData :: forall syntax r-            . ( Projectible (Sql92InsertValuesExpressionSyntax syntax) r-              , IsSql92InsertValuesSyntax syntax )-           => [ r ] -> SqlInsertValues syntax r+insertData :: forall be r+            . ( Projectible be r, BeamSqlBackend be )+           => [ r ] -> SqlInsertValues be r insertData rows =   case rows of     [] -> SqlInsertValuesEmpty-    _  -> SqlInsertValues (insertSqlExpressions (map mkSqlExprs rows))-  where-    mkSqlExprs :: r -> [Sql92InsertValuesExpressionSyntax syntax]-    mkSqlExprs r = execWriter (project' (Proxy @AnyType) (\_ s -> tell [ s "t" ] >> pure s) r)+    _  -> SqlInsertValues (insertSqlExpressions (map (\row -> project (Proxy @be) row "t") rows))  -- | Build a 'SqlInsertValues' from a 'SqlSelect' that returns the same table-insertFrom-    :: ( IsSql92InsertValuesSyntax syntax-       , HasQBuilder (Sql92InsertValuesSelectSyntax syntax)-       , Projectible (Sql92SelectExpressionSyntax (Sql92InsertValuesSelectSyntax syntax)) r )-    => Q (Sql92InsertValuesSelectSyntax syntax) db QueryInaccessible r-    -> SqlInsertValues syntax r+insertFrom :: ( BeamSqlBackend be, HasQBuilder be+              , Projectible be r )+           => Q be db QBaseScope r+           -> SqlInsertValues be r insertFrom s = SqlInsertValues (insertFromSql (buildSqlQuery "t" s))  -- * UPDATE  -- | Represents a SQL @UPDATE@ statement for the given @table@.-data SqlUpdate syntax (table :: (* -> *) -> *)-  = SqlUpdate syntax+data SqlUpdate be (table :: (* -> *) -> *)+  = SqlUpdate !(TableSettings table) !(BeamSqlBackendUpdateSyntax be)   | SqlIdentityUpdate -- An update with no assignments  -- | Build a 'SqlUpdate' given a table, a list of assignments, and a way to@@ -283,94 +299,188 @@ --   represents the left hand side of assignments. Sometimes, you'd like to also --   get the current value of a particular column. You can use the 'current_' --   function to convert a 'QField' to a 'QExpr'.-update :: ( Beamable table-          , IsSql92UpdateSyntax syntax) =>-          DatabaseEntity be db (TableEntity table)+update :: ( BeamSqlBackend be, Beamable table )+       => DatabaseEntity be db (TableEntity table)           -- ^ The table to insert into-       -> (forall s. table (QField s) -> [ QAssignment (Sql92UpdateFieldNameSyntax syntax) (Sql92UpdateExpressionSyntax syntax) s ])+       -> (forall s. table (QField s) -> QAssignment be s)           -- ^ A sequence of assignments to make.-       -> (forall s. table (QExpr (Sql92UpdateExpressionSyntax syntax) s) -> QExpr (Sql92UpdateExpressionSyntax syntax) s Bool)+       -> (forall s. table (QExpr be s) -> QExpr be s Bool)           -- ^ Build a @WHERE@ clause given a table containing expressions-       -> SqlUpdate syntax table-update (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkAssignments mkWhere =+       -> SqlUpdate be table+update (DatabaseEntity dt@(DatabaseTable {})) mkAssignments mkWhere =   case assignments of     [] -> SqlIdentityUpdate-    _  -> SqlUpdate (updateStmt tblNm assignments (Just (where_ "t")))+    _  -> SqlUpdate (dbTableSettings dt)+                    (updateStmt (tableNameFromEntity dt)+                       assignments (Just (where_ "t")))   where-    assignments = concatMap (\(QAssignment as) -> as) (mkAssignments tblFields)+    QAssignment assignments = mkAssignments tblFields     QExpr where_ = mkWhere tblFieldExprs -    tblFields = changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QField False tblNm name)) tblSettings+    tblFields = changeBeamRep (\(Columnar' fd) -> Columnar' (QField False (dbTableCurrentName dt) (fd ^. fieldName)))+                              (dbTableSettings dt)     tblFieldExprs = changeBeamRep (\(Columnar' (QField _ _ nm)) -> Columnar' (QExpr (pure (fieldE (unqualifiedField nm))))) tblFields --- | Generate a 'SqlUpdate' that will update the given table with the given value.+-- | A specialization of 'update' that matches the given (already existing) row+updateRow :: ( BeamSqlBackend be, Table table+             , HasTableEquality be (PrimaryKey table)+             , SqlValableTable be (PrimaryKey table) )+          => DatabaseEntity be db (TableEntity table)+             -- ^ The table to insert into+          -> table Identity+             -- ^ The row to update+          -> (forall s. table (QField s) -> QAssignment be s)+             -- ^ A sequence of assignments to make.+          -> SqlUpdate be table+updateRow tbl row update' =+  update tbl update' (references_ (val_ (pk row)))++-- | A specialization of 'update' that is more convenient for normal tables.+updateTable :: forall table db be+             . ( BeamSqlBackend be, Beamable table )+            => DatabaseEntity be db (TableEntity table)+               -- ^ The table to update+            -> table (QFieldAssignment be table)+               -- ^ Updates to be made (use 'set' to construct an empty field)+            -> (forall s. table (QExpr be s) -> QExpr be s Bool)+            -> SqlUpdate be table+updateTable tblEntity assignments mkWhere =+  let mkAssignments :: forall s. table (QField s) -> QAssignment be s+      mkAssignments tblFields =+        let tblExprs = changeBeamRep (\(Columnar' fd) -> Columnar' (current_ fd)) tblFields+        in execWriter $+           zipBeamFieldsM+             (\(Columnar' field :: Columnar' (QField s) a)+               c@(Columnar' (QFieldAssignment mkAssignment)) ->+                case mkAssignment tblExprs of+                  Nothing -> pure c+                  Just newValue -> do+                    tell (field <-. newValue)+                    pure c)+             tblFields assignments++  in update tblEntity mkAssignments mkWhere++-- | Convenience form of 'updateTable' that generates a @WHERE@ clause+-- that matches only the already existing entity+updateTableRow :: ( BeamSqlBackend be, Table table+                  , HasTableEquality be (PrimaryKey table)+                  , SqlValableTable be (PrimaryKey table) )+               => DatabaseEntity be db (TableEntity table)+                  -- ^ The table to update+               -> table Identity+                  -- ^ The row to update+               -> table (QFieldAssignment be table)+                  -- ^ Updates to be made (use 'set' to construct an empty field)+               -> SqlUpdate be table+updateTableRow tbl row update' =+  updateTable tbl update' (references_ (val_ (pk row)))++set :: forall table be table'. Beamable table => table (QFieldAssignment be table')+set = changeBeamRep (\_ -> Columnar' (QFieldAssignment (\_ -> Nothing))) (tblSkeleton :: TableSkeleton table)++setFieldsTo :: forall table be table'+             . Table table => (forall s. table (QExpr be s)) -> table (QFieldAssignment be table')+setFieldsTo tbl =++  runIdentity $+  zipBeamFieldsM (\(Columnar' (Const columnIx))+                   (Columnar' (QExpr newValue)) ->+                    if columnIx `elem` primaryKeyIndices+                    then pure $ Columnar' toOldValue+                    else pure $ Columnar' (toNewValue (QExpr newValue)))+                 indexedTable tbl++  where+    indexedTable :: table (Const Int)+    indexedTable =+      flip evalState 0 $+      zipBeamFieldsM (\_ _ -> do+                         n <- get+                         put (n + 1)+                         return (Columnar' (Const n)))+        (tblSkeleton :: TableSkeleton table) (tblSkeleton :: TableSkeleton table)++    primaryKeyIndices :: [ Int ]+    primaryKeyIndices = allBeamValues (\(Columnar' (Const ix)) -> ix) (primaryKey indexedTable)++-- | Use with 'set' to set a field to an explicit new value that does+-- not depend on any other value+toNewValue :: (forall s. QExpr be s a) -> QFieldAssignment be table a+toNewValue newVal = toUpdatedValue (\_ -> newVal)++-- | Use with 'set' to not modify the field+toOldValue :: QFieldAssignment be table a+toOldValue = toUpdatedValueMaybe (\_ -> Nothing)++-- | Use with 'set' to set a field to a new value that is calculated+-- based on one or more fields from the existing row+toUpdatedValue :: (forall s. table (QExpr be s) -> QExpr be s a) -> QFieldAssignment be table a+toUpdatedValue mkNewVal = toUpdatedValueMaybe (Just <$> mkNewVal)++-- | Use with 'set' to optionally set a fiield to a new value,+-- calculated based on one or more fields from the existing row+toUpdatedValueMaybe :: (forall s. table (QExpr be s) -> Maybe (QExpr be s a)) -> QFieldAssignment be table a+toUpdatedValueMaybe = QFieldAssignment++-- | Generate a 'SqlUpdate' that will update the given table row with the given value. -- --   The SQL @UPDATE@ that is generated will set every non-primary key field for --   the row where each primary key field is exactly what is given. -- --   Note: This is a pure SQL @UPDATE@ command. This does not upsert or merge values.-save :: forall table syntax be db.+save :: forall table be db.         ( Table table-        , IsSql92UpdateSyntax syntax--        , SqlValableTable (PrimaryKey table) (Sql92UpdateExpressionSyntax syntax)-        , SqlValableTable table (Sql92UpdateExpressionSyntax syntax)+        , BeamSqlBackend be -        , HasTableEquality (Sql92UpdateExpressionSyntax syntax) (PrimaryKey table)+        , SqlValableTable be (PrimaryKey table)+        , SqlValableTable be table -        , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92UpdateExpressionSyntax syntax)) Bool+        , HasTableEquality be (PrimaryKey table)         )      => DatabaseEntity be db (TableEntity table)         -- ^ Table to update      -> table Identity         -- ^ Value to set to-     -> SqlUpdate syntax table-save tbl@(DatabaseEntity (DatabaseTable _ tblSettings)) v =-  update tbl (\(tblField :: table (QField s)) ->-                execWriter $-                zipBeamFieldsM-                  (\(Columnar' field) c@(Columnar' value) ->-                     do when (qFieldName field `notElem` primaryKeyFieldNames) $-                          tell [ field <-. value ]-                        pure c)-                  tblField (val_ v :: table (QExpr (Sql92UpdateExpressionSyntax syntax) s)))-             (\tblE -> primaryKey tblE ==. val_ (primaryKey v))--  where-    primaryKeyFieldNames =-      allBeamValues (\(Columnar' (TableField fieldNm)) -> fieldNm) (primaryKey tblSettings)+     -> SqlUpdate be table+save tbl v =+  updateTableRow tbl v+    (setFieldsTo (val_ v))  -- | Run a 'SqlUpdate' in a 'MonadBeam'.-runUpdate :: (IsSql92Syntax cmd, MonadBeam cmd be hdl m)-          => SqlUpdate (Sql92UpdateSyntax cmd) tbl -> m ()-runUpdate (SqlUpdate u) = runNoReturn (updateCmd u)+runUpdate :: (BeamSqlBackend be, MonadBeam be m)+          => SqlUpdate be tbl -> m ()+runUpdate (SqlUpdate _ u) = runNoReturn (updateCmd u) runUpdate SqlIdentityUpdate = pure ()  -- * DELETE  -- | Represents a SQL @DELETE@ statement for the given @table@-newtype SqlDelete syntax (table :: (* -> *) -> *) = SqlDelete syntax+data SqlDelete be (table :: (* -> *) -> *)+  = SqlDelete !(TableSettings table) !(BeamSqlBackendDeleteSyntax be)  -- | Build a 'SqlDelete' from a table and a way to build a @WHERE@ clause-delete :: forall be db delete table-        . IsSql92DeleteSyntax delete+delete :: forall be db table+        . BeamSqlBackend be        => DatabaseEntity be db (TableEntity table)           -- ^ Table to delete from-       -> (forall s. (forall s'. table (QExpr (Sql92DeleteExpressionSyntax delete) s')) -> QExpr (Sql92DeleteExpressionSyntax delete) s Bool)+       -> (forall s. (forall s'. table (QExpr be s')) -> QExpr be s Bool)           -- ^ Build a @WHERE@ clause given a table containing expressions-       -> SqlDelete delete table-delete (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkWhere =-  SqlDelete (deleteStmt tblNm alias (Just (where_ "t")))+       -> SqlDelete be table+delete (DatabaseEntity dt@(DatabaseTable {})) mkWhere =+  SqlDelete (dbTableSettings dt)+            (deleteStmt (tableNameFromEntity dt) alias (Just (where_ "t")))   where-    supportsAlias = deleteSupportsAlias (Proxy @delete)+    supportsAlias = deleteSupportsAlias (Proxy @(BeamSqlBackendDeleteSyntax be))      tgtName = "delete_target"     alias = if supportsAlias then Just tgtName else Nothing     mkField = if supportsAlias then qualifiedField tgtName else unqualifiedField -    QExpr where_ = mkWhere (changeBeamRep (\(Columnar' (TableField name)) -> Columnar' (QExpr (pure (fieldE (mkField name))))) tblSettings)+    QExpr where_ = mkWhere (changeBeamRep (\(Columnar' fd) -> Columnar' (QExpr (pure (fieldE (mkField (fd ^. fieldName))))))+                             (dbTableSettings dt))  -- | Run a 'SqlDelete' in a 'MonadBeam'-runDelete :: (IsSql92Syntax cmd, MonadBeam cmd be hdl m)-          => SqlDelete (Sql92DeleteSyntax cmd) table -> m ()-runDelete (SqlDelete d) = runNoReturn (deleteCmd d)+runDelete :: (BeamSqlBackend be, MonadBeam be m)+          => SqlDelete be table -> m ()+runDelete (SqlDelete _ d) = runNoReturn (deleteCmd d)

@@ -12,6 +12,7 @@     -- ** General-purpose aggregate functions #gp-agg-funcs#   , sum_, avg_, min_, max_, count_, countAll_   , rank_, cumeDist_, percentRank_, denseRank_+  , rowNumber_    , every_, any_, some_ @@ -40,6 +41,9 @@  import Data.Typeable +type Aggregable be a =+  ProjectibleWithPredicate AggregateContext be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) a+ -- | Compute an aggregate over a query. -- --   The supplied aggregate projection should return an aggregate expression (an@@ -58,27 +62,27 @@ -- --   For usage examples, see --   <https://tathougies.github.io/beam/user-guide/queries/aggregates/ the manual>.-aggregate_ :: forall select a r db s.-              ( ProjectibleWithPredicate AggregateContext (Sql92SelectExpressionSyntax select) a-              , Projectible (Sql92SelectExpressionSyntax select) r-              , Projectible (Sql92SelectExpressionSyntax select) a+aggregate_ :: forall be a r db s.+              ( BeamSqlBackend be+              , Aggregable be a, Projectible be r, Projectible be a                , ContextRewritable a               , ThreadRewritable (QNested s) (WithRewrittenContext a QValueContext)--              , IsSql92SelectSyntax select )+              )            => (r -> a)                  -- ^ Aggregate projection-           -> Q select db (QNested s) r -- ^ Query to aggregate over-           -> Q select db s (WithRewrittenThread (QNested s) s (WithRewrittenContext a QValueContext))+           -> Q be db (QNested s) r -- ^ Query to aggregate over+           -> Q be db s (WithRewrittenThread (QNested s) s (WithRewrittenContext a QValueContext)) aggregate_ mkAggregation (Q aggregating) =   Q (liftF (QAggregate mkAggregation' aggregating (rewriteThread (Proxy @s) . rewriteContext (Proxy @QValueContext))))   where     mkAggregation' x tblPfx =       let agg = mkAggregation x-          doProject :: AggregateContext c => Proxy c -> WithExprContext (Sql92SelectExpressionSyntax select)-                    -> Writer [WithExprContext (Sql92SelectExpressionSyntax select)]-                              (WithExprContext (Sql92SelectExpressionSyntax select))-          doProject p expr =+          doProject :: AggregateContext c+                    => Proxy c -> Proxy be+                    -> WithExprContext (BeamSqlBackendExpressionSyntax' be)+                    -> Writer [WithExprContext (BeamSqlBackendExpressionSyntax' be)]+                              (WithExprContext (BeamSqlBackendExpressionSyntax' be))+          doProject p _ expr =             case cast p of               Just (Proxy :: Proxy QGroupingContext) ->                 tell [ expr ] >> pure expr@@ -88,7 +92,9 @@                     pure expr                   Nothing -> error "aggregate_: impossible" -          groupingExprs = execWriter (project' (Proxy @AggregateContext) doProject agg)+          groupingExprs =+            fmap (fmap fromBeamSqlBackendExpressionSyntax) $+            execWriter (project' (Proxy @AggregateContext) (Proxy @(be, WithExprContext (BeamSqlBackendExpressionSyntax' be))) doProject agg)       in case groupingExprs of            [] -> (Nothing, agg)            _ -> (Just (groupByExpressions (sequenceA groupingExprs tblPfx)), agg)@@ -101,16 +107,23 @@   group_ :: expr -> grouped  -- | 'group_' for simple value expressions.-instance QGroupable (QExpr expr s a) (QGroupExpr expr s a) where+instance QGroupable (QExpr be s a) (QGroupExpr be s a) where   group_ (QExpr a) = QExpr a  -- | 'group_' for any 'Beamable' type. Adds every field in the type to the --   grouping key. This is the equivalent of including the grouping expression --   of each field in the type as part of the aggregate projection instance Beamable tbl =>-  QGroupable (tbl (QExpr expr s)) (tbl (QGroupExpr expr s)) where+  QGroupable (tbl (QExpr be s)) (tbl (QGroupExpr be s)) where   group_ = changeBeamRep (\(Columnar' (QExpr x)) -> Columnar' (QExpr x)) +-- | 'group_' for any 'Beamable' type. Adds every field in the type to the+--   grouping key. This is the equivalent of including the grouping expression+--   of each field in the type as part of the aggregate projection+instance Beamable tbl =>+  QGroupable (tbl (Nullable (QExpr be s))) (tbl (Nullable (QGroupExpr be s))) where+  group_ = changeBeamRep (\(Columnar' (QExpr x)) -> Columnar' (QExpr x))+ -- | Compute an aggregate over all values in a group. Corresponds semantically --   to the @AGG(ALL ..)@ syntax, but doesn't produce an explicit @ALL@. To --   produce @ALL@ expicitly, see 'allInGroupExplicitly_'.@@ -132,7 +145,7 @@ --   'allInGroup_' has the same semantic meaning, but does not produce an --   explicit @ALL@. allInGroupExplicitly_ :: IsSql92AggregationSetQuantifierSyntax s-                     => Maybe s+                      => Maybe s allInGroupExplicitly_ = Just setQuantifierAll  -- ** Aggregations@@ -141,110 +154,114 @@ --    `countAll_`) because empty aggregates return SQL @NULL@ values.  -- | SQL @MIN(ALL ..)@ function (but without the explicit ALL)-min_ :: IsSql92AggregationExpressionSyntax expr-     => QExpr expr s a -> QAgg expr s (Maybe a)+min_ :: BeamSqlBackend be+     => QExpr be s a -> QAgg be s (Maybe a) min_ = minOver_ allInGroup_  -- | SQL @MAX(ALL ..)@ function (but without the explicit ALL)-max_ :: IsSql92AggregationExpressionSyntax expr-     => QExpr expr s a -> QAgg expr s (Maybe a)+max_ :: BeamSqlBackend be+     => QExpr be s a -> QAgg be s (Maybe a) max_ = maxOver_ allInGroup_  -- | SQL @AVG(ALL ..)@ function (but without the explicit ALL)-avg_ :: ( IsSql92AggregationExpressionSyntax expr, Num a )-     => QExpr expr s a -> QAgg expr s (Maybe a)+avg_ :: ( BeamSqlBackend be, Num a )+     => QExpr be s a -> QAgg be s (Maybe a) avg_ = avgOver_ allInGroup_  -- | SQL @SUM(ALL ..)@ function (but without the explicit ALL)-sum_ :: ( IsSql92AggregationExpressionSyntax expr, Num a )-     => QExpr expr s a -> QAgg expr s (Maybe a)+sum_ :: ( BeamSqlBackend be, Num a )+     => QExpr be s a -> QAgg be s (Maybe a) sum_ = sumOver_ allInGroup_  -- | SQL @COUNT(*)@ function-countAll_ :: IsSql92AggregationExpressionSyntax expr => QAgg expr s Int+countAll_ :: BeamSqlBackend be => QAgg be s Int countAll_ = QExpr (pure countAllE)  -- | SQL @COUNT(ALL ..)@ function (but without the explicit ALL)-count_ :: ( IsSql92AggregationExpressionSyntax expr-          , Integral b ) => QExpr expr s a -> QAgg expr s b+count_ :: ( BeamSqlBackend be, Integral b )+       => QExpr be s a -> QAgg be s b count_ (QExpr over) = QExpr (countE Nothing <$> over)  -- | SQL2003 @CUME_DIST@ function (Requires T612 Advanced OLAP operations support)-cumeDist_ :: IsSql2003ExpressionAdvancedOLAPOperationsSyntax expr-          => QAgg expr s Double+cumeDist_ :: BeamSqlT612Backend be+          => QAgg be s Double cumeDist_ = QExpr (pure cumeDistAggE)  -- | SQL2003 @PERCENT_RANK@ function (Requires T612 Advanced OLAP operations support)-percentRank_ :: IsSql2003ExpressionAdvancedOLAPOperationsSyntax expr-             => QAgg expr s Double+percentRank_ :: BeamSqlT612Backend be+             => QAgg be s Double percentRank_ = QExpr (pure percentRankAggE) -denseRank_ :: IsSql2003ExpressionAdvancedOLAPOperationsSyntax expr-           => QAgg expr s Int+-- | SQL2003 @DENSE_RANK@ function (Requires T612 Advanced OLAP operations support)+denseRank_ :: BeamSqlT612Backend be+           => QAgg be s Int denseRank_ = QExpr (pure denseRankAggE) +-- | SQL2003 @ROW_NUMBER@ function+rowNumber_ :: BeamSql2003ExpressionBackend be+           =>  QAgg be s Int+rowNumber_ = QExpr (pure rowNumberE)+ -- | SQL2003 @RANK@ function (Requires T611 Elementary OLAP operations support)-rank_ :: IsSql2003ExpressionElementaryOLAPOperationsSyntax expr-      => QAgg expr s Int+rank_ :: BeamSqlT611Backend be+      => QAgg be s Int rank_ = QExpr (pure rankAggE)  minOver_, maxOver_-  :: IsSql92AggregationExpressionSyntax expr-  => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s a -> QAgg expr s (Maybe a)+  :: BeamSqlBackend be+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be)+  -> QExpr be s a -> QAgg be s (Maybe a) minOver_ q (QExpr a) = QExpr (minE q <$> a) maxOver_ q (QExpr a) = QExpr (maxE q <$> a)  avgOver_, sumOver_-  :: ( IsSql92AggregationExpressionSyntax expr-     , Num a )-  => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s a -> QAgg expr s (Maybe a)+  :: ( BeamSqlBackend be, Num a )+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be)+  -> QExpr be s a -> QAgg be s (Maybe a) avgOver_ q (QExpr a) = QExpr (avgE q <$> a) sumOver_ q (QExpr a) = QExpr (sumE q <$> a)  countOver_-  :: ( IsSql92AggregationExpressionSyntax expr-     , Integral b )-  => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s a -> QAgg expr s b+  :: ( BeamSqlBackend be, Integral b )+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be)+  -> QExpr be s a -> QAgg be s b countOver_ q (QExpr a) = QExpr (countE q <$> a)  -- | SQL @EVERY@, @SOME@, and @ANY@ aggregates. Operates over -- 'SqlBool' only, as the result can be @NULL@, even if all inputs are -- known (no input rows). everyOver_, someOver_, anyOver_-  :: IsSql99AggregationExpressionSyntax expr-  => Maybe (Sql92AggregationSetQuantifierSyntax expr)-  -> QExpr expr s SqlBool -> QAgg expr s SqlBool+  :: BeamSql99AggregationBackend be+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be)+  -> QExpr be s SqlBool -> QAgg be s SqlBool everyOver_ q (QExpr a) = QExpr (everyE q <$> a) someOver_  q (QExpr a) = QExpr (someE  q <$> a) anyOver_   q (QExpr a) = QExpr (anyE   q <$> a)  -- | Support for FILTER (WHERE ...) syntax for aggregates.---   Part of SQL2003 Advanced OLAP operations feature (T612).+--   Part of SQL2003 Elementary OLAP operations feature (T611). -- -- See 'filterWhere_'' for a version that accepts 'SqlBool'.-filterWhere_ :: IsSql2003ExpressionElementaryOLAPOperationsSyntax expr-             => QAgg expr s a -> QExpr expr s Bool -> QAgg expr s a+filterWhere_ :: BeamSqlT611Backend be+             => QAgg be s a -> QExpr be s Bool -> QAgg be s a filterWhere_ agg cond = filterWhere_' agg (sqlBool_ cond)  -- | Like 'filterWhere_' but accepting 'SqlBool'.-filterWhere_' :: IsSql2003ExpressionElementaryOLAPOperationsSyntax expr-              => QAgg expr s a -> QExpr expr s SqlBool -> QAgg expr s a+filterWhere_' :: BeamSqlT611Backend be+              => QAgg be s a -> QExpr be s SqlBool -> QAgg be s a filterWhere_' (QExpr agg) (QExpr cond) = QExpr (liftA2 filterAggE agg cond)  -- | SQL99 @EVERY(ALL ..)@ function (but without the explicit ALL)-every_ :: IsSql99AggregationExpressionSyntax expr-       => QExpr expr s SqlBool -> QAgg expr s SqlBool+every_ :: BeamSql99AggregationBackend be+       => QExpr be s SqlBool -> QAgg be s SqlBool every_ = everyOver_ allInGroup_  -- | SQL99 @SOME(ALL ..)@ function (but without the explicit ALL)-some_ :: IsSql99AggregationExpressionSyntax expr-      => QExpr expr s SqlBool -> QAgg expr s SqlBool+some_ :: BeamSql99AggregationBackend be+      => QExpr be s SqlBool -> QAgg be s SqlBool some_  = someOver_  allInGroup_  -- | SQL99 @ANY(ALL ..)@ function (but without the explicit ALL)-any_ :: IsSql99AggregationExpressionSyntax expr-     => QExpr expr s SqlBool -> QAgg expr s SqlBool+any_ :: BeamSql99AggregationBackend be+     => QExpr be s SqlBool -> QAgg be s SqlBool any_   = anyOver_   allInGroup_

@@ -0,0 +1,89 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}++module Database.Beam.Query.CTE where++import Database.Beam.Backend.SQL+import Database.Beam.Query.Internal+import Database.Beam.Query.Types++import Control.Monad.Free.Church+import Control.Monad.Writer hiding ((<>))+import Control.Monad.State.Strict++import Data.Text (Text)+import Data.String+import Data.Proxy (Proxy(Proxy))+#if !MIN_VERSION_base(4, 11, 0)+import           Data.Semigroup+#endif+++import Unsafe.Coerce++data Recursiveness be where+    Nonrecursive :: Recursiveness be+    Recursive    :: IsSql99RecursiveCommonTableExpressionSelectSyntax (BeamSqlBackendSelectSyntax be)+                 => Recursiveness be++instance Monoid (Recursiveness be) where+    mempty = Nonrecursive+    mappend Recursive _ = Recursive+    mappend _ Recursive = Recursive+    mappend _ _ = Nonrecursive++instance Semigroup (Recursiveness be) where+  (<>) = mappend++newtype With be (db :: (* -> *) -> *) a+    = With { runWith :: WriterT (Recursiveness be, [ BeamSql99BackendCTESyntax be ])+                                (State Int) a }+    deriving (Monad, Applicative, Functor)++instance IsSql99RecursiveCommonTableExpressionSelectSyntax (BeamSqlBackendSelectSyntax be)+    => MonadFix (With be db) where+    mfix f = With (tell (Recursive, mempty) >> mfix (runWith . f))++data QAnyScope++data ReusableQ be db res where+    ReusableQ :: Proxy res -> (forall s. Proxy s -> Q be db s (WithRewrittenThread QAnyScope s res)) -> ReusableQ be db res++reusableForCTE :: forall be res db+                . ( ThreadRewritable QAnyScope res+                  , Projectible be res+                  , BeamSqlBackend be )+               => Text -> ReusableQ be db res+reusableForCTE tblNm =+    ReusableQ (Proxy @res)+              (\proxyS ->+                 Q $ liftF (QAll (\_ -> fromTable (tableNamed (tableName Nothing tblNm)) . Just . (, Nothing))+                                 (\tblNm' -> fst $ mkFieldNames @be @res (qualifiedField tblNm'))+                                 (\_ -> Nothing)+                                 (rewriteThread @QAnyScope @res proxyS . snd)))++selecting :: forall res be db+           . ( BeamSql99CommonTableExpressionBackend be, HasQBuilder be+             , Projectible be res+             , ThreadRewritable QAnyScope res )+          => Q be db QAnyScope res -> With be db (ReusableQ be db res)+selecting q =+  With $ do+    cteId <- get+    put (cteId + 1)++    let tblNm = fromString ("cte" ++ show cteId)++        (_ :: res, fieldNames) = mkFieldNames @be (qualifiedField tblNm)+    tell (Nonrecursive, [ cteSubquerySyntax tblNm fieldNames (buildSqlQuery (tblNm <> "_") q) ])++    pure (reusableForCTE tblNm)++rescopeQ :: QM be db s res -> QM be db s' res+rescopeQ = unsafeCoerce++reuse :: forall s be db res+       . ReusableQ be db res -> Q be db s (WithRewrittenThread QAnyScope s res)+reuse (ReusableQ _ q) = q (Proxy @s)+

@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}  module Database.Beam.Query.Combinators     ( -- * Various SQL functions and constructs@@ -23,7 +24,7 @@      -- * General query combinators -    , all_+    , all_, values_     , allFromView_, join_, join_'     , guard_, guard_', filter_, filter_'     , related_, relatedBy_, relatedBy_'@@ -74,13 +75,15 @@  import Database.Beam.Schema.Tables -#if !MIN_VERSION_base(4, 11, 0)-import Control.Monad.Writer-#endif import Control.Monad.Identity import Control.Monad.Free import Control.Applicative +#if !MIN_VERSION_base(4, 11, 0)+import Control.Monad.Writer hiding ((<>))+import Data.Semigroup+#endif+ import Data.Maybe import Data.Proxy import Data.Time (LocalTime)@@ -88,79 +91,73 @@ import GHC.Generics  -- | Introduce all entries of a table into the 'Q' monad-all_ :: forall be (db :: (* -> *) -> *) table select s.-        ( Database be db-        , IsSql92SelectSyntax select--        , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))-        , IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)))-        , Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)--        , Table table )+all_ :: ( Database be db, BeamSqlBackend be )        => DatabaseEntity be db (TableEntity table)-       -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))-all_ (DatabaseEntity (DatabaseTable tblNm tblSettings)) =-    Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd)+       -> Q be db s (table (QExpr be s))+all_ (DatabaseEntity dt@(DatabaseTable {})) =+    Q $ liftF (QAll (\_ -> fromTable (tableNamed (tableName (dbTableSchema dt) (dbTableCurrentName dt))) . Just . (,Nothing))+                    (tableFieldsToExpressions (dbTableSettings dt))+                    (\_ -> Nothing) snd)  -- | Introduce all entries of a view into the 'Q' monad-allFromView_ :: forall be (db :: (* -> *) -> *) table select s.-                ( Database be db-                , IsSql92SelectSyntax select--                , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))-                , IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)))-                , Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)-                , Beamable table )+allFromView_ :: ( Database be db, Beamable table+                , BeamSqlBackend be )                => DatabaseEntity be db (ViewEntity table)-               -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))-allFromView_ (DatabaseEntity (DatabaseView tblNm tblSettings)) =-    Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\_ -> Nothing) snd)+               -> Q be db s (table (QExpr be s))+allFromView_ (DatabaseEntity vw) =+    Q $ liftF (QAll (\_ -> fromTable (tableNamed (tableName (dbViewSchema vw) (dbViewCurrentName vw))) . Just . (,Nothing))+                    (tableFieldsToExpressions (dbViewSettings vw))+                    (\_ -> Nothing) snd) +values_ :: forall be db s a+         . ( Projectible be a+           , BeamSqlBackend be )+        => [ a ] -> Q be db s a+values_ rows =+    Q $ liftF (QAll (\tblPfx -> fromTable (tableFromValues (map (\row -> project (Proxy @be) row tblPfx) rows)) . Just . (,Just fieldNames))+                    (\tblNm' -> fst $ mkFieldNames (qualifiedField tblNm'))+                    (\_ -> Nothing) snd)+    where+      fieldNames = snd $ mkFieldNames @be @a unqualifiedField+ -- | Introduce all entries of a table into the 'Q' monad based on the --   given QExpr. The join condition is expected to return a --   'Bool'. For a version that takes 'SqlBool' (a possibly @UNKNOWN@ --   boolean, that maps more closely to the SQL standard), see --   'join_''.-join_ :: ( Database be db, Table table-         , IsSql92SelectSyntax select-         , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))-         , Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)-         , IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))) ) =>-         DatabaseEntity be db (TableEntity table)-      -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)-      -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))+join_ :: ( Database be db, Table table, BeamSqlBackend be )+      => DatabaseEntity be db (TableEntity table)+      -> (table (QExpr be s) -> QExpr be s Bool)+      -> Q be db s (table (QExpr be s)) join_ tbl mkOn = join_' tbl (sqlBool_ . mkOn)  -- | Like 'join_', but accepting an @ON@ condition that returns -- 'SqlBool'-join_' :: ( Database be db, Table table-          , IsSql92SelectSyntax select-          , IsSql92FromSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))-          , Sql92FromExpressionSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select)) ~ Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)-          , IsSql92TableSourceSyntax (Sql92FromTableSourceSyntax (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))) ) =>-          DatabaseEntity be db (TableEntity table)-       -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)-       -> Q select db s (table (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))-join_' (DatabaseEntity (DatabaseTable tblNm tblSettings)) mkOn =-    Q $ liftF (QAll (\_ -> fromTable (tableNamed tblNm) . Just) tblSettings (\tbl -> let QExpr on = mkOn tbl in Just on) snd)+join_' :: ( Database be db, Table table, BeamSqlBackend be )+       => DatabaseEntity be db (TableEntity table)+       -> (table (QExpr be s) -> QExpr be s SqlBool)+       -> Q be db s (table (QExpr be s))+join_' (DatabaseEntity tbl@(DatabaseTable {})) mkOn =+    Q $ liftF (QAll (\_ -> fromTable (tableNamed (tableName (dbTableSchema tbl) (dbTableCurrentName tbl))) . Just . (, Nothing))+                    (tableFieldsToExpressions (dbTableSettings tbl))+                    (\tbl' -> let QExpr on = mkOn tbl' in Just on) snd)  -- | Introduce a table using a left join with no ON clause. Because this is not --   an inner join, the resulting table is made nullable. This means that each --   field that would normally have type 'QExpr x' will now have type 'QExpr --   (Maybe x)'.-perhaps_ :: forall s r select db.-          ( Projectible (Sql92SelectExpressionSyntax select) r-          , IsSql92SelectSyntax select+perhaps_ :: forall s r be db.+          ( Projectible be r, BeamSqlBackend be           , ThreadRewritable (QNested s) r-          , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )-         => Q select db (QNested s) r-         -> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))+          , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r) )+         => Q be db (QNested s) r+         -> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r)) perhaps_ (Q sub) =   Q $ liftF (QArbitraryJoin               sub leftJoin               (\_ -> Nothing)-              (\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) a) ->-                                            Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) a) $+              (\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->+                                            Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $                                   rewriteThread (Proxy @s) r))  -- | Outer join. every row of each table, returning @NULL@ for any row@@ -169,43 +166,45 @@ -- This expects a join expression returning 'Bool', for a version that -- accepts a 'SqlBool' (a possibly @UNKNOWN@ boolean, that maps more -- closely to the SQL standard), see 'outerJoin_''-outerJoin_ :: forall s a b select db.-              ( Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b+outerJoin_ :: forall s a b be db.+              ( BeamSqlBackend be, BeamSqlBackendSupportsOuterJoin be+              , Projectible be a, Projectible be b               , ThreadRewritable (QNested s) a, ThreadRewritable (QNested s) b-              , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s a)-              , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s b)-              , IsSql92FromOuterJoinSyntax (Sql92SelectFromSyntax select) )-           => Q select db (QNested s) a-           -> Q select db (QNested s) b-           -> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr (Sql92SelectExpressionSyntax select) s Bool )-           -> Q select db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)-                            , Retag Nullable (WithRewrittenThread (QNested s) s b) )+              , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s a)+              , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s b)+              )+           => Q be db (QNested s) a+           -> Q be db (QNested s) b+           -> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr be s Bool )+           -> Q be db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)+                        , Retag Nullable (WithRewrittenThread (QNested s) s b) ) outerJoin_ a b on_ = outerJoin_' a b (sqlBool_ . on_)  -- | Like 'outerJoin_', but accepting 'SqlBool'. Pairs of rows for -- which the join condition is unknown are considered to be unrelated, -- by SQL compliant databases at least.-outerJoin_' :: forall s a b select db.-               ( Projectible (Sql92SelectExpressionSyntax select) a, Projectible (Sql92SelectExpressionSyntax select) b+outerJoin_' :: forall s a b be db.+               ( BeamSqlBackend be, BeamSqlBackendSupportsOuterJoin be+               , Projectible be a, Projectible be b                , ThreadRewritable (QNested s) a, ThreadRewritable (QNested s) b-               , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s a)-               , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s b)-               , IsSql92FromOuterJoinSyntax (Sql92SelectFromSyntax select) )-            => Q select db (QNested s) a-            -> Q select db (QNested s) b-            -> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr (Sql92SelectExpressionSyntax select) s SqlBool )-            -> Q select db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)-                             , Retag Nullable (WithRewrittenThread (QNested s) s b) )+               , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s a)+               , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s b)+               )+            => Q be db (QNested s) a+            -> Q be db (QNested s) b+            -> ( (WithRewrittenThread (QNested s) s a, WithRewrittenThread (QNested s) s b) -> QExpr be s SqlBool )+            -> Q be db s ( Retag Nullable (WithRewrittenThread (QNested s) s a)+                         , Retag Nullable (WithRewrittenThread (QNested s) s b) ) outerJoin_' (Q a) (Q b) on_ =   Q $ liftF (QTwoWayJoin a b outerJoin               (\(a', b') ->                  let QExpr e = on_ (rewriteThread (Proxy @s) a', rewriteThread (Proxy @s) b')                  in Just e)               (\(a', b') ->-                 let retag' :: (ThreadRewritable (QNested s) x, Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s x))+                 let retag' :: (ThreadRewritable (QNested s) x, Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s x))                             => x -> Retag Nullable (WithRewrittenThread (QNested s) s x)-                     retag' = retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) x) ->-                                        Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) x) .+                     retag' = retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) x) ->+                                        Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) x) .                               rewriteThread (Proxy @s)                  in ( retag' a', retag' b' ))) @@ -216,47 +215,45 @@ -- --   The @ON@ condition given must return 'Bool'. For a version that --   accepts an @ON@ condition returning 'SqlBool', see 'leftJoin_''.-leftJoin_ :: forall s r select db.-           ( Projectible (Sql92SelectExpressionSyntax select) r-           , IsSql92SelectSyntax select+leftJoin_ :: forall s r be db.+           ( BeamSqlBackend be, Projectible be r            , ThreadRewritable (QNested s) r-           , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )-          => Q select db (QNested s) r-          -> (WithRewrittenThread (QNested s) s r -> QExpr (Sql92SelectExpressionSyntax select) s Bool)-          -> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))+           , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r) )+          => Q be db (QNested s) r+          -> (WithRewrittenThread (QNested s) s r -> QExpr be s Bool)+          -> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r)) leftJoin_ sub on_ = leftJoin_' sub (sqlBool_ . on_)  -- | Like 'leftJoin_', but accepts an @ON@ clause returning 'SqlBool'.-leftJoin_' :: forall s r select db.-            ( Projectible (Sql92SelectExpressionSyntax select) r-            , IsSql92SelectSyntax select+leftJoin_' :: forall s r be db.+            ( BeamSqlBackend be, Projectible be r             , ThreadRewritable (QNested s) r-            , Retaggable (QExpr (Sql92SelectExpressionSyntax select) s) (WithRewrittenThread (QNested s) s r) )-           => Q select db (QNested s) r-           -> (WithRewrittenThread (QNested s) s r -> QExpr (Sql92SelectExpressionSyntax select) s SqlBool)-           -> Q select db s (Retag Nullable (WithRewrittenThread (QNested s) s r))+            , Retaggable (QExpr be s) (WithRewrittenThread (QNested s) s r) )+           => Q be db (QNested s) r+           -> (WithRewrittenThread (QNested s) s r -> QExpr be s SqlBool)+           -> Q be db s (Retag Nullable (WithRewrittenThread (QNested s) s r)) leftJoin_' (Q sub) on_ =   Q $ liftF (QArbitraryJoin                sub leftJoin                (\r -> let QExpr e = on_ (rewriteThread (Proxy @s) r) in Just e)-               (\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr (Sql92SelectExpressionSyntax select) s) a) ->-                                Columnar' (QExpr e) :: Columnar' (Nullable (QExpr (Sql92SelectExpressionSyntax select) s)) a) $+               (\r -> retag (\(Columnar' (QExpr e) :: Columnar' (QExpr be s) a) ->+                                Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) $                       rewriteThread (Proxy @s) r)) -subselect_ :: forall s r select db.+subselect_ :: forall s r be db.             ( ThreadRewritable (QNested s) r-            , ProjectibleInSelectSyntax select r )-           => Q select db (QNested s) r-           -> Q select db s (WithRewrittenThread (QNested s) s r)+            , Projectible be r )+           => Q be db (QNested s) r+           -> Q be db s (WithRewrittenThread (QNested s) s r) subselect_ (Q q') =   Q (liftF (QSubSelect q' (rewriteThread (Proxy @s))))  -- | Only allow results for which the 'QExpr' yields 'True'. For a -- version that operates over possibly @NULL@ 'SqlBool's, see -- 'guard_''.-guard_ :: forall select db s.-          ( IsSql92SelectSyntax select ) =>-          QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool -> Q select db s ()+guard_ :: forall be db s+        . BeamSqlBackend be+       => QExpr be s Bool -> Q be db s () guard_ = guard_' . sqlBool_  -- | Only allow results for which the 'QExpr' yields @TRUE@.@@ -265,179 +262,149 @@ -- 'Bool's, except for the special @UNKNOWN@ value that occurs when -- comparisons include @NULL@. For a version that operates over known -- non-@NULL@ booleans, see 'guard_'.-guard_' :: forall select db s-         . IsSql92SelectSyntax select-        => QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool -> Q select db s ()+guard_' :: forall be db s+         . BeamSqlBackend be+        => QExpr be s SqlBool -> Q be db s () guard_' (QExpr guardE') = Q (liftF (QGuard guardE' ()))  -- | Synonym for @clause >>= \x -> guard_ (mkExpr x)>> pure x@. Use 'filter_'' for comparisons with 'SqlBool'-filter_ :: forall r select db s.-           ( IsSql92SelectSyntax select )-        => (r -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)-        -> Q select db s r -> Q select db s r+filter_ :: forall r be db s+         . BeamSqlBackend be+        => (r -> QExpr be s Bool)+        -> Q be db s r -> Q be db s r filter_ mkExpr clause = clause >>= \x -> guard_ (mkExpr x) >> pure x  -- | Synonym for @clause >>= \x -> guard_' (mkExpr x)>> pure x@. Use 'filter_' for comparisons with 'Bool'-filter_' :: forall r select db s.-           ( IsSql92SelectSyntax select )-        => (r -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)-        -> Q select db s r -> Q select db s r+filter_' :: forall r be db s+          . BeamSqlBackend be+        => (r -> QExpr be s SqlBool)+        -> Q be db s r -> Q be db s r filter_' mkExpr clause = clause >>= \x -> guard_' (mkExpr x) >> pure x  -- | Introduce all entries of the given table which are referenced by the given 'PrimaryKey'-related_ :: forall be db rel select s.-            ( IsSql92SelectSyntax select-            , HasTableEquality (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) (PrimaryKey rel)-            , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool-            , Database be db, Table rel ) =>-            DatabaseEntity be db (TableEntity rel)-         -> PrimaryKey rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s)-         -> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))+related_ :: forall be db rel s+          . ( Database be db, Table rel, BeamSqlBackend be+            , HasTableEquality be (PrimaryKey rel)+            )+         => DatabaseEntity be db (TableEntity rel)+         -> PrimaryKey rel (QExpr be s)+         -> Q be db s (rel (QExpr be s)) related_ relTbl relKey =   join_ relTbl (\rel -> relKey ==. primaryKey rel)  -- | Introduce all entries of the given table which for which the expression (which can depend on the queried table returns true)-relatedBy_ :: forall be db rel select s.-              ( Database be db, Table rel-              , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool-              , IsSql92SelectSyntax select )+relatedBy_ :: forall be db rel s+            . ( Database be db, Table rel, BeamSqlBackend be )            => DatabaseEntity be db (TableEntity rel)-           -> (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s) ->-                QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool)-           -> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))+           -> (rel (QExpr be s) -> QExpr be s Bool)+           -> Q be db s (rel (QExpr be s)) relatedBy_ = join_  -- | Introduce all entries of the given table which for which the expression (which can depend on the queried table returns true)-relatedBy_' :: forall be db rel select s.-               ( Database be db, Table rel-               , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select))) Bool-               , IsSql92SelectSyntax select )+relatedBy_' :: forall be db rel s+             . ( Database be db, Table rel, BeamSqlBackend be )             => DatabaseEntity be db (TableEntity rel)-            -> (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s) ->-                 QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s SqlBool)-            -> Q select db s (rel (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s))+            -> (rel (QExpr be s) -> QExpr be s SqlBool)+            -> Q be db s (rel (QExpr be s)) relatedBy_' = join_'  -- | Generate an appropriate boolean 'QGenExpr' comparing the given foreign key --   to the given table. Useful for creating join conditions.-references_ :: ( IsSql92ExpressionSyntax expr-               , HasTableEquality expr (PrimaryKey t)-               , HasSqlValueSyntax (Sql92ExpressionValueSyntax expr) Bool-               , Table t )-            => PrimaryKey t (QGenExpr ctxt expr s) -> t (QGenExpr ctxt expr s) -> QGenExpr ctxt expr s Bool+references_ :: ( Table t, BeamSqlBackend be+               , HasTableEquality be (PrimaryKey t) )+            => PrimaryKey t (QGenExpr ctxt be s) -> t (QGenExpr ctxt be s) -> QGenExpr ctxt be s Bool references_ fk tbl = fk ==. pk tbl  -- | Only return distinct values from a query-nub_ :: ( IsSql92SelectSyntax select-        , Projectible (Sql92SelectExpressionSyntax select) r )-     => Q select db s r -> Q select db s r+nub_ :: ( BeamSqlBackend be, Projectible be r )+     => Q be db s r -> Q be db s r nub_ (Q sub) = Q $ liftF (QDistinct (\_ _ -> setQuantifierDistinct) sub id)  -- | Limit the number of results returned by a query.-limit_ :: forall s a select db.-           ( ProjectibleInSelectSyntax select a-          , ThreadRewritable (QNested s) a ) =>-          Integer -> Q select db (QNested s) a -> Q select db s (WithRewrittenThread (QNested s) s a)+limit_ :: forall s a be db+        . ( Projectible be a+          , ThreadRewritable (QNested s) a )+        => Integer -> Q be db (QNested s) a -> Q be db s (WithRewrittenThread (QNested s) s a) limit_ limit' (Q q) =   Q (liftF (QLimit limit' q (rewriteThread (Proxy @s))))  -- | Drop the first `offset'` results.-offset_ :: forall s a select db.-           ( ProjectibleInSelectSyntax select a-           , ThreadRewritable (QNested s) a ) =>-           Integer -> Q select db (QNested s) a -> Q select db s (WithRewrittenThread (QNested s) s a)+offset_ :: forall s a be db+         . ( Projectible be a+           , ThreadRewritable (QNested s) a )+        => Integer -> Q be db (QNested s) a -> Q be db s (WithRewrittenThread (QNested s) s a) offset_ offset' (Q q) =   Q (liftF (QOffset offset' q (rewriteThread (Proxy @s))))  -- | Use the SQL @EXISTS@ operator to determine if the given query returns any results-exists_ :: ( IsSql92SelectSyntax select-           , HasQBuilder select-           , ProjectibleInSelectSyntax select a-           , Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select)-        => Q select db s a-        -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool+exists_ :: ( BeamSqlBackend be, HasQBuilder be, Projectible be a)+        => Q be db s a -> QExpr be s Bool exists_ q = QExpr (\tbl -> existsE (buildSqlQuery tbl q))  -- | Use the SQL @UNIQUE@ operator to determine if the given query produces a unique result-unique_ :: ( IsSql92SelectSyntax select-           , HasQBuilder select-           , ProjectibleInSelectSyntax select a-           , Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select)-        => Q select db s a-        -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool+unique_ :: ( BeamSqlBackend be, HasQBuilder be, Projectible be a)+        => Q be db s a -> QExpr be s Bool unique_ q = QExpr (\tbl -> uniqueE (buildSqlQuery tbl q))  -- | Use the SQL99 @DISTINCT@ operator to determine if the given query produces a distinct result-distinct_ :: ( IsSql99ExpressionSyntax (Sql92SelectExpressionSyntax select)-             , HasQBuilder select-             , ProjectibleInSelectSyntax select a-             , Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select) =>-             Q select db s a-          -> QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s Bool+distinct_ :: ( BeamSqlBackend be, BeamSql99ExpressionBackend be, HasQBuilder be, Projectible be a)+          => Q be db s a -> QExpr be s Bool distinct_ q = QExpr (\tbl -> distinctE (buildSqlQuery tbl q))  -- | Project the (presumably) singular result of the given query as an expression-subquery_ ::-  ( IsSql92SelectSyntax select-  , HasQBuilder select-  , ProjectibleInSelectSyntax select (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)-  , Sql92ExpressionSelectSyntax (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) ~ select) =>-  Q select (db :: (* -> *) -> *) s (QExpr (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a)-  -> QGenExpr ctxt (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) s a+subquery_ :: ( BeamSqlBackend be, HasQBuilder be, Projectible be (QExpr be s a) )+          => Q be db s (QExpr be s a)+          -> QGenExpr ctxt be s a subquery_ q =   QExpr (\tbl -> subqueryE (buildSqlQuery tbl q))  -- | SQL @CHAR_LENGTH@ function-charLength_ :: ( IsSqlExpressionSyntaxStringType syntax text-               , IsSql92ExpressionSyntax syntax )-            => QGenExpr context syntax s text -> QGenExpr context syntax s Int+charLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text )+            => QGenExpr context be s text -> QGenExpr context be s Int charLength_ (QExpr s) = QExpr (charLengthE <$> s)  -- | SQL @OCTET_LENGTH@ function-octetLength_ :: ( IsSqlExpressionSyntaxStringType syntax text-                , IsSql92ExpressionSyntax syntax )-             => QGenExpr context syntax s text -> QGenExpr context syntax s Int+octetLength_ :: ( BeamSqlBackend be, BeamSqlBackendIsString be text )+             => QGenExpr context be s text -> QGenExpr context be s Int octetLength_ (QExpr s) = QExpr (octetLengthE <$> s)  -- | SQL @BIT_LENGTH@ function-bitLength_ ::-  IsSql92ExpressionSyntax syntax =>-  QGenExpr context syntax s SqlBitString -> QGenExpr context syntax s Int+bitLength_ :: BeamSqlBackend be+           => QGenExpr context be s SqlBitString -> QGenExpr context be s Int bitLength_ (QExpr x) = QExpr (bitLengthE <$> x)  -- | SQL @CURRENT_TIMESTAMP@ function-currentTimestamp_ :: IsSql92ExpressionSyntax syntax => QGenExpr ctxt syntax s LocalTime+currentTimestamp_ :: BeamSqlBackend be => QGenExpr ctxt be s LocalTime currentTimestamp_ = QExpr (pure currentTimestampE)  -- | SQL @POSITION(.. IN ..)@ function-position_ ::-  ( IsSqlExpressionSyntaxStringType syntax text-  , IsSql92ExpressionSyntax syntax, Integral b ) =>-  QExpr syntax s text -> QExpr syntax s text -> QExpr syntax s b+position_ :: ( BeamSqlBackendIsString be text+             , BeamSqlBackend be, Integral b )+          => QExpr be s text -> QExpr be s text -> QExpr be s b position_ (QExpr needle) (QExpr haystack) =   QExpr (liftA2 likeE needle haystack)  -- | SQL @LOWER@ function-lower_ :: ( IsSqlExpressionSyntaxStringType syntax text-          , IsSql92ExpressionSyntax syntax )-       => QGenExpr context syntax s text -> QGenExpr context syntax s text+lower_ ::  ( BeamSqlBackendIsString be text+           , BeamSqlBackend be )+       => QGenExpr context be s text -> QGenExpr context be s text lower_ (QExpr s) = QExpr (lowerE <$> s)  -- | SQL @UPPER@ function-upper_ :: ( IsSqlExpressionSyntaxStringType syntax text-          , IsSql92ExpressionSyntax syntax )-       => QGenExpr context syntax s text -> QGenExpr context syntax s text+upper_ :: ( BeamSqlBackendIsString be text+          , BeamSqlBackend be )+       => QGenExpr context be s text -> QGenExpr context be s text upper_ (QExpr s) = QExpr (upperE <$> s)  -- | SQL @TRIM@ function-trim_ :: ( IsSqlExpressionSyntaxStringType syntax text-         , IsSql92ExpressionSyntax syntax )-      => QGenExpr context syntax s text -> QGenExpr context syntax s text+trim_ :: ( BeamSqlBackendIsString be text+         , BeamSqlBackend be )+       => QGenExpr context be s text -> QGenExpr context be s text trim_ (QExpr s) = QExpr (trimE <$> s)  -- | Combine all the given boolean value 'QGenExpr's with the '&&.' operator.-allE :: ( IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool) =>-        [ QGenExpr context syntax s Bool ] -> QGenExpr context syntax s Bool+allE :: BeamSqlBackend be+     => [ QGenExpr context be s Bool ] -> QGenExpr context be s Bool allE es = fromMaybe (QExpr (pure (valueE (sqlValueSyntax True)))) $           foldl (\expr x ->                    Just $ maybe x (\e -> e &&. x) expr)@@ -446,101 +413,90 @@ -- * UPDATE operators  -- | Extract an expression representing the current (non-UPDATEd) value of a 'QField'-current_ :: IsSql92ExpressionSyntax expr-         => QField s ty -> QExpr expr s ty+current_ :: BeamSqlBackend be => QField s ty -> QExpr be s ty current_ (QField False _ nm) = QExpr (pure (fieldE (unqualifiedField nm))) current_ (QField True tbl nm) = QExpr (pure (fieldE (qualifiedField tbl nm)))  infix 4 <-.-class SqlUpdatable expr s lhs rhs | rhs -> expr, lhs -> s, rhs -> s, lhs s expr -> rhs, rhs -> lhs where+class BeamSqlBackend be =>+  SqlUpdatable be s lhs rhs | rhs -> be, lhs -> s+                            , rhs -> s, lhs s be -> rhs+                            , rhs -> lhs where++   -- | Update a 'QField' or 'Beamable' type containing 'QField's with the given   --   'QExpr' or 'Beamable' type containing 'QExpr'-  (<-.) :: forall fieldName.-           IsSql92FieldNameSyntax fieldName-        => lhs+  (<-.) :: lhs         -> rhs-        -> QAssignment fieldName expr s-instance SqlUpdatable expr s (QField s a) (QExpr expr s a) where+        -> QAssignment be s++instance BeamSqlBackend be => SqlUpdatable be s (QField s a) (QExpr be s a) where   QField _ _ nm <-. QExpr expr =     QAssignment [(unqualifiedField nm, expr "t")]-instance Beamable tbl => SqlUpdatable expr s (tbl (QField s)) (tbl (QExpr expr s)) where-  (<-.) :: forall fieldName.-           IsSql92FieldNameSyntax fieldName-        => tbl (QField s) -> tbl (QExpr expr s)-        -> QAssignment fieldName expr s++instance (BeamSqlBackend be, Beamable tbl) => SqlUpdatable be s (tbl (QField s)) (tbl (QExpr be s)) where   lhs <-. rhs =     QAssignment $     allBeamValues (\(Columnar' (Const assignments)) -> assignments) $     runIdentity $     zipBeamFieldsM (\(Columnar' (QField _ _ f) :: Columnar' (QField s) t) (Columnar' (QExpr e)) ->-                       pure (Columnar' (Const (unqualifiedField f, e "t")) :: Columnar' (Const (fieldName,expr)) t)) lhs rhs-instance Beamable tbl => SqlUpdatable expr s (tbl (Nullable (QField s))) (tbl (Nullable (QExpr expr s))) where+                       pure (Columnar' (Const (unqualifiedField f, e "t")) :: Columnar' (Const (BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)) t)) lhs rhs++instance (BeamSqlBackend be, Beamable tbl) => SqlUpdatable be s (tbl (Nullable (QField s))) (tbl (Nullable (QExpr be s))) where   lhs <-. rhs =     let lhs' = changeBeamRep (\(Columnar' (QField q tblName fieldName') :: Columnar' (Nullable (QField s)) a) ->                                 Columnar' (QField q tblName fieldName') :: Columnar' (QField s)  a) lhs-        rhs' = changeBeamRep (\(Columnar' (QExpr e) :: Columnar' (Nullable (QExpr expr s)) a) ->-                                Columnar' (QExpr e) :: Columnar' (QExpr expr s) a) rhs+        rhs' = changeBeamRep (\(Columnar' (QExpr e) :: Columnar' (Nullable (QExpr be s)) a) ->+                                Columnar' (QExpr e) :: Columnar' (QExpr be s) a) rhs     in lhs' <-. rhs'  -- | SQL @UNION@ operator-union_ :: forall select db s a.-          ( IsSql92SelectSyntax select-          , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-          , ProjectibleInSelectSyntax select a-          , ThreadRewritable (QNested s) a)-       => Q select db (QNested s) a -> Q select db (QNested s) a-       -> Q select db s (WithRewrittenThread (QNested s) s a)-union_ (Q a) (Q b) = Q (liftF (QUnion False a b (rewriteThread (Proxy @s))))+union_ :: forall be db s a+        . ( BeamSqlBackend be, Projectible be a+          , ThreadRewritable (QNested s) a )+       => Q be db (QNested s) a -> Q be db (QNested s) a+       -> Q be db s (WithRewrittenThread (QNested s) s a)+union_ (Q a) (Q b) = Q (liftF (QSetOp (unionTables False) a b (rewriteThread (Proxy @s))))  -- | SQL @UNION ALL@ operator-unionAll_ :: forall select db s a.-             ( IsSql92SelectSyntax select-             , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-             , ProjectibleInSelectSyntax select a+unionAll_ :: forall be db s a.+             ( BeamSqlBackend be, Projectible be a              , ThreadRewritable (QNested s) a)-          => Q select db (QNested s) a -> Q select db (QNested s) a-          -> Q select db s (WithRewrittenThread (QNested s) s a)-unionAll_ (Q a) (Q b) = Q (liftF (QUnion True a b (rewriteThread (Proxy @s))))+          => Q be db (QNested s) a -> Q be db (QNested s) a+          -> Q be db s (WithRewrittenThread (QNested s) s a)+unionAll_ (Q a) (Q b) = Q (liftF (QSetOp (unionTables True) a b (rewriteThread (Proxy @s))))  -- | SQL @INTERSECT@ operator-intersect_ :: forall select db s a.-              ( IsSql92SelectSyntax select-              , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-              , ProjectibleInSelectSyntax select a+intersect_ :: forall be db s a.+              ( BeamSqlBackend be, Projectible be a               , ThreadRewritable (QNested s) a)-           => Q select db (QNested s) a -> Q select db (QNested s) a-           -> Q select db s (WithRewrittenThread (QNested s) s a)-intersect_ (Q a) (Q b) = Q (liftF (QIntersect False a b (rewriteThread (Proxy @s))))+           => Q be db (QNested s) a -> Q be db (QNested s) a+           -> Q be db s (WithRewrittenThread (QNested s) s a)+intersect_ (Q a) (Q b) = Q (liftF (QSetOp (intersectTables False) a b (rewriteThread (Proxy @s))))  -- | SQL @INTERSECT ALL@ operator-intersectAll_ :: forall select db s a.-                 ( IsSql92SelectSyntax select-                 , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-                 , ProjectibleInSelectSyntax select a+intersectAll_ :: forall be db s a.+                 ( BeamSqlBackend be, Projectible be a                  , ThreadRewritable (QNested s) a)-              => Q select db (QNested s) a -> Q select db (QNested s) a-              -> Q select db s (WithRewrittenThread (QNested s) s a)-intersectAll_ (Q a) (Q b) = Q (liftF (QIntersect True a b (rewriteThread (Proxy @s))))+              => Q be db (QNested s) a -> Q be db (QNested s) a+              -> Q be db s (WithRewrittenThread (QNested s) s a)+intersectAll_ (Q a) (Q b) = Q (liftF (QSetOp (intersectTables True) a b (rewriteThread (Proxy @s))))  -- | SQL @EXCEPT@ operator-except_ :: forall select db s a.-           ( IsSql92SelectSyntax select-           , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-           , ProjectibleInSelectSyntax select a+except_ :: forall be db s a.+           ( BeamSqlBackend be, Projectible be a            , ThreadRewritable (QNested s) a)-        => Q select db (QNested s) a -> Q select db (QNested s) a-        -> Q select db s (WithRewrittenThread (QNested s) s a)-except_ (Q a) (Q b) = Q (liftF (QExcept False a b (rewriteThread (Proxy @s))))+        => Q be db (QNested s) a -> Q be db (QNested s) a+        -> Q be db s (WithRewrittenThread (QNested s) s a)+except_ (Q a) (Q b) = Q (liftF (QSetOp (exceptTable False) a b (rewriteThread (Proxy @s))))  -- | SQL @EXCEPT ALL@ operator-exceptAll_ :: forall select db s a.-              ( IsSql92SelectSyntax select-              , Projectible (Sql92SelectTableExpressionSyntax (Sql92SelectSelectTableSyntax select)) a-              , ProjectibleInSelectSyntax select a+exceptAll_ :: forall be db s a.+              ( BeamSqlBackend be, Projectible be a               , ThreadRewritable (QNested s) a)-           => Q select db (QNested s) a -> Q select db (QNested s) a-           -> Q select db s (WithRewrittenThread (QNested s) s a)-exceptAll_ (Q a) (Q b) = Q (liftF (QExcept True a b (rewriteThread (Proxy @s))))+           => Q be db (QNested s) a -> Q be db (QNested s) a+           -> Q be db s (WithRewrittenThread (QNested s) s a)+exceptAll_ (Q a) (Q b) = Q (liftF (QSetOp (exceptTable True) a b (rewriteThread (Proxy @s))))  -- | Convenience function that allows you to use type applications to specify --   the result of a 'QGenExpr'.@@ -558,120 +514,112 @@ -- -- > aggregate_ (\_ -> as_ @Int countAll_) .. ---as_ :: forall a ctxt syntax s. QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a+as_ :: forall a ctxt be s. QGenExpr ctxt be s a -> QGenExpr ctxt be s a as_ = id  -- * Marshalling between Haskell literals and QExprs  type family HaskellLiteralForQExpr x = a-type instance HaskellLiteralForQExpr (QGenExpr context syntax s a) = a-type instance HaskellLiteralForQExpr (table (QGenExpr context syntax s)) = table Identity+type instance HaskellLiteralForQExpr (QGenExpr context be s a) = a+type instance HaskellLiteralForQExpr (table (QGenExpr context be s)) = table Identity type instance HaskellLiteralForQExpr (table (Nullable f)) = HaskellLiteralForQExpr_AddNullable (HaskellLiteralForQExpr (table f))  type family HaskellLiteralForQExpr_AddNullable x = a type instance HaskellLiteralForQExpr_AddNullable (tbl f) = tbl (Nullable f) -type family QExprSyntax x where-  QExprSyntax (QGenExpr ctxt syntax s a) = syntax--type SqlValableTable table expr =+type SqlValableTable be table =    ( Beamable table-   , IsSql92ExpressionSyntax expr-   , FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax expr)) table )+   , FieldsFulfillConstraint (HasSqlValueSyntax (BeamSqlBackendValueSyntax be)) table )  class SqlValable a where     val_ :: HaskellLiteralForQExpr a -> a -instance (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) a, IsSql92ExpressionSyntax syntax) =>-  SqlValable (QGenExpr ctxt syntax s a) where+instance ( BeamSqlBackendCanSerialize be a, BeamSqlBackend be ) =>+  SqlValable (QGenExpr ctxt be s a) where    val_ = QExpr . pure . valueE . sqlValueSyntax-instance ( Beamable table-         , IsSql92ExpressionSyntax syntax-         , FieldsFulfillConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) table ) =>-  SqlValable (table (QGenExpr ctxt syntax s)) where+instance ( Beamable table, BeamSqlBackend be+         , FieldsFulfillConstraint (BeamSqlBackendCanSerialize be) table ) =>+  SqlValable (table (QGenExpr ctxt be s)) where   val_ tbl =-    let fields :: table (WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))-        fields = to (gWithConstrainedFields (Proxy @(HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))+    let fields :: table (WithConstraint (BeamSqlBackendCanSerialize be))+        fields = to (gWithConstrainedFields (Proxy @(BeamSqlBackendCanSerialize be))                                             (Proxy @(Rep (table Exposed))) (from tbl))-    in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) x)) ->+    in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (BeamSqlBackendCanSerialize be) x)) ->                          Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields-instance ( Beamable table-         , IsSql92ExpressionSyntax syntax--         , FieldsFulfillConstraintNullable (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) table ) =>+instance ( Beamable table, BeamSqlBackend be+         , FieldsFulfillConstraintNullable (BeamSqlBackendCanSerialize be) table ) => -         SqlValable (table (Nullable (QGenExpr ctxt syntax s))) where+         SqlValable (table (Nullable (QGenExpr ctxt be s))) where    val_ tbl =-    let fields :: table (Nullable (WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax))))-        fields = to (gWithConstrainedFields (Proxy @(HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)))+    let fields :: table (Nullable (WithConstraint (BeamSqlBackendCanSerialize be)))+        fields = to (gWithConstrainedFields (Proxy @(BeamSqlBackendCanSerialize be))                                             (Proxy @(Rep (table (Nullable Exposed)))) (from tbl))-    in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax)) (Maybe x))) ->+    in changeBeamRep (\(Columnar' (WithConstraint x :: WithConstraint (BeamSqlBackendCanSerialize be) (Maybe x))) ->                          Columnar' (QExpr (pure (valueE (sqlValueSyntax x))))) fields -default_ :: IsSql92ExpressionSyntax expr-         => QGenExpr ctxt expr s a+default_ :: BeamSqlBackend be => QGenExpr ctxt be s a default_ = QExpr (pure defaultE)  -- * Window functions -noBounds_ :: QFrameBounds syntax+noBounds_ :: QFrameBounds be noBounds_ = QFrameBounds Nothing -fromBound_ :: IsSql2003WindowFrameBoundsSyntax syntax-           => QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax)-           -> QFrameBounds syntax+fromBound_ :: BeamSql2003ExpressionBackend be+           => QFrameBound be -> QFrameBounds be fromBound_ start = bounds_ start Nothing -bounds_ :: IsSql2003WindowFrameBoundsSyntax syntax-        => QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax)-        -> Maybe (QFrameBound (Sql2003WindowFrameBoundsBoundSyntax syntax))-        -> QFrameBounds syntax+bounds_ :: BeamSql2003ExpressionBackend be+        => QFrameBound be+        -> Maybe (QFrameBound be)+        -> QFrameBounds be bounds_ (QFrameBound start) end =     QFrameBounds . Just $     fromToBoundSyntax start       (fmap (\(QFrameBound end') -> end') end) -unbounded_ :: IsSql2003WindowFrameBoundSyntax syntax-           => QFrameBound syntax+unbounded_ :: BeamSql2003ExpressionBackend be => QFrameBound be unbounded_ = QFrameBound unboundedSyntax -nrows_ :: IsSql2003WindowFrameBoundSyntax syntax-       => Int -> QFrameBound syntax+nrows_ :: BeamSql2003ExpressionBackend be+       => Int -> QFrameBound be nrows_ x = QFrameBound (nrowsBoundSyntax x) -noPartition_, noOrder_ :: Maybe (QOrd syntax s Int)-noOrder_ = Nothing+noPartition_ :: Maybe (QExpr be s Int) noPartition_ = Nothing +noOrder_ :: Maybe (QOrd be s Int)+noOrder_ = Nothing+ partitionBy_, orderPartitionBy_ :: partition -> Maybe partition partitionBy_  = Just orderPartitionBy_ = Just  -- | Specify a window frame with all the options-frame_ :: ( IsSql2003ExpressionSyntax syntax-          , SqlOrderable (Sql2003WindowFrameOrderingSyntax (Sql2003ExpressionWindowFrameSyntax syntax)) ordering-          , Projectible syntax partition-          , Sql2003ExpressionSanityCheck syntax )-       => Maybe partition             {-^ PARTITION BY -}-       -> Maybe ordering              {-^ ORDER BY -}-       -> QFrameBounds (Sql2003WindowFrameBoundsSyntax (Sql2003ExpressionWindowFrameSyntax syntax)) {-^ RANGE / ROWS -}-       -> QWindow (Sql2003ExpressionWindowFrameSyntax syntax) s+frame_ :: forall be ordering partition s+        . ( BeamSql2003ExpressionBackend be+          , SqlOrderable be ordering+          , Projectible be partition )+       => Maybe partition {-^ PARTITION BY -}+       -> Maybe ordering  {-^ ORDER BY -}+       -> QFrameBounds be {-^ RANGE / ROWS -}+       -> QWindow be s frame_ partition_ ordering_ (QFrameBounds bounds) =     QWindow $ \tblPfx ->-    frameSyntax (case maybe [] (flip project tblPfx) partition_ of+    frameSyntax (case maybe [] (flip (project (Proxy @be)) tblPfx) partition_ of                    [] -> Nothing                    xs -> Just xs)-                (case fmap makeSQLOrdering ordering_ of+                (case fmap (makeSQLOrdering (Proxy @be)) ordering_ of                    Nothing -> Nothing                    Just [] -> Nothing                    Just xs -> Just (sequenceA xs tblPfx))                 bounds  -- | Produce a window expression given an aggregate function and a window.-over_ :: IsSql2003ExpressionSyntax syntax =>-         QAgg syntax s a -> QWindow (Sql2003ExpressionWindowFrameSyntax syntax) s -> QWindowExpr syntax s a+over_ :: BeamSql2003ExpressionBackend be+      => QAgg be s a -> QWindow be s -> QWindowExpr be s a over_ (QExpr a) (QWindow frame) = QExpr (overE <$> a <*> frame)  -- | Compute a query over windows.@@ -686,72 +634,63 @@ --   function, window expressions can be included in the output using the --   'over_' function. ---withWindow_ :: forall window a s r select db.-               ( ProjectibleWithPredicate WindowFrameContext (Sql2003ExpressionWindowFrameSyntax (Sql92SelectExpressionSyntax select)) window-               , Projectible (Sql92SelectExpressionSyntax select) r-               , Projectible (Sql92SelectExpressionSyntax select) a+withWindow_ :: forall window a s r be db+             . ( ProjectibleWithPredicate WindowFrameContext be (WithExprContext (BeamSqlBackendWindowFrameSyntax' be)) window+               , Projectible be r, Projectible be a                , ContextRewritable a-               , ThreadRewritable (QNested s) (WithRewrittenContext a QValueContext)-               , IsSql92SelectSyntax select)+               , ThreadRewritable (QNested s) (WithRewrittenContext a QValueContext) )             => (r -> window)      -- ^ Window builder function             -> (r -> window -> a) -- ^ Projection builder function. Has access to the windows generated above-            -> Q select db (QNested s) r -- ^ Query to window over-            -> Q select db s (WithRewrittenThread (QNested s) s (WithRewrittenContext a QValueContext))+            -> Q be db (QNested s) r -- ^ Query to window over+            -> Q be db s (WithRewrittenThread (QNested s) s (WithRewrittenContext a QValueContext)) withWindow_ mkWindow mkProjection (Q windowOver)=   Q (liftF (QWindowOver mkWindow mkProjection windowOver (rewriteThread (Proxy @s) . rewriteContext (Proxy @QValueContext))))  -- * Order bys -class SqlOrderable syntax a | a -> syntax where-    makeSQLOrdering :: a -> [ WithExprContext syntax ]-instance SqlOrderable syntax (QOrd syntax s a) where-    makeSQLOrdering (QExpr x) = [x]-instance SqlOrderable syntax a => SqlOrderable syntax [a] where-    makeSQLOrdering = concatMap makeSQLOrdering-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b ) => SqlOrderable syntax (a, b) where-    makeSQLOrdering (a, b) = makeSQLOrdering a <> makeSQLOrdering b-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c ) => SqlOrderable syntax (a, b, c) where-    makeSQLOrdering (a, b, c) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c-         , SqlOrderable syntax d ) => SqlOrderable syntax (a, b, c, d) where-    makeSQLOrdering (a, b, c, d) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c-         , SqlOrderable syntax d-         , SqlOrderable syntax e ) => SqlOrderable syntax (a, b, c, d, e) where-    makeSQLOrdering (a, b, c, d, e) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <> makeSQLOrdering e-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c-         , SqlOrderable syntax d-         , SqlOrderable syntax e-         , SqlOrderable syntax f ) => SqlOrderable syntax (a, b, c, d, e, f) where-    makeSQLOrdering (a, b, c, d, e, f) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <> makeSQLOrdering e <> makeSQLOrdering f-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c-         , SqlOrderable syntax d-         , SqlOrderable syntax e-         , SqlOrderable syntax f-         , SqlOrderable syntax g ) => SqlOrderable syntax (a, b, c, d, e, f, g) where-    makeSQLOrdering (a, b, c, d, e, f, g) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <>-                                            makeSQLOrdering e <> makeSQLOrdering f <> makeSQLOrdering g-instance ( SqlOrderable syntax a-         , SqlOrderable syntax b-         , SqlOrderable syntax c-         , SqlOrderable syntax d-         , SqlOrderable syntax e-         , SqlOrderable syntax f-         , SqlOrderable syntax g-         , SqlOrderable syntax h) => SqlOrderable syntax (a, b, c, d, e, f, g, h) where-    makeSQLOrdering (a, b, c, d, e, f, g, h) = makeSQLOrdering a <> makeSQLOrdering b <> makeSQLOrdering c <> makeSQLOrdering d <>-                                            makeSQLOrdering e <> makeSQLOrdering f <> makeSQLOrdering g <> makeSQLOrdering h+class SqlOrderable be a | a -> be where+    makeSQLOrdering :: Proxy be -> a -> [ WithExprContext (BeamSqlBackendOrderingSyntax be) ]+instance SqlOrderable be (QOrd be s a) where+    makeSQLOrdering _ (QOrd x) = [x]+instance SqlOrderable be a => SqlOrderable be [a] where+    makeSQLOrdering be = concatMap (makeSQLOrdering be)+instance ( SqlOrderable be a, SqlOrderable be b ) => SqlOrderable be (a, b) where+    makeSQLOrdering be (a, b) =+      makeSQLOrdering be a <> makeSQLOrdering be b+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c ) => SqlOrderable be (a, b, c) where+    makeSQLOrdering be (a, b, c) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c, SqlOrderable be d ) => SqlOrderable be (a, b, c, d) where+    makeSQLOrdering be (a, b, c, d) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c <> makeSQLOrdering be d+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c, SqlOrderable be d+         , SqlOrderable be e ) => SqlOrderable be (a, b, c, d, e) where+    makeSQLOrdering be (a, b, c, d, e) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c <> makeSQLOrdering be d <>+      makeSQLOrdering be e+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c, SqlOrderable be d+         , SqlOrderable be e, SqlOrderable be f ) => SqlOrderable be (a, b, c, d, e, f) where+    makeSQLOrdering be (a, b, c, d, e, f) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c <> makeSQLOrdering be d <>+      makeSQLOrdering be e <> makeSQLOrdering be f+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c, SqlOrderable be d+         , SqlOrderable be e, SqlOrderable be f+         , SqlOrderable be g ) => SqlOrderable be (a, b, c, d, e, f, g) where+    makeSQLOrdering be (a, b, c, d, e, f, g) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c <> makeSQLOrdering be d <>+      makeSQLOrdering be e <> makeSQLOrdering be f <> makeSQLOrdering be g+instance ( SqlOrderable be a, SqlOrderable be b+         , SqlOrderable be c, SqlOrderable be d+         , SqlOrderable be e, SqlOrderable be f+         , SqlOrderable be g, SqlOrderable be h ) => SqlOrderable be (a, b, c, d, e, f, g, h) where+    makeSQLOrdering be (a, b, c, d, e, f, g, h) =+      makeSQLOrdering be a <> makeSQLOrdering be b <> makeSQLOrdering be c <> makeSQLOrdering be d <>+      makeSQLOrdering be e <> makeSQLOrdering be f <> makeSQLOrdering be g <> makeSQLOrdering be h  -- | Order by the given expressions. The return type of the ordering key should --   either be the result of 'asc_' or 'desc_' (or another ordering 'QOrd'@@ -760,35 +699,32 @@ -- --   The <https://tathougies.github.io/beam/user-guide/queries/ordering manual section> --   has more information.-orderBy_ :: forall s a ordering syntax db.-            ( Projectible (Sql92SelectExpressionSyntax syntax) a-            , SqlOrderable (Sql92SelectOrderingSyntax syntax) ordering-            , ThreadRewritable (QNested s) a) =>-            (a -> ordering) -> Q syntax db (QNested s) a -> Q syntax db s (WithRewrittenThread (QNested s) s a)+orderBy_ :: forall s a ordering be db+          . ( Projectible be a, SqlOrderable be ordering+            , ThreadRewritable (QNested s) a )+         => (a -> ordering) -> Q be db (QNested s) a -> Q be db s (WithRewrittenThread (QNested s) s a) orderBy_ orderer (Q q) =-    Q (liftF (QOrderBy (sequenceA . makeSQLOrdering . orderer) q (rewriteThread (Proxy @s))))+    Q (liftF (QOrderBy (sequenceA . makeSQLOrdering (Proxy @be) . orderer) q (rewriteThread (Proxy @s)))) -nullsFirst_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax syntax-            => QOrd syntax s a-            -> QOrd syntax s a-nullsFirst_ (QExpr e) = QExpr (nullsFirstOrdering <$> e)+nullsFirst_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax (BeamSqlBackendOrderingSyntax be)+            => QOrd be s a -> QOrd be s a+nullsFirst_ (QOrd e) = QOrd (nullsFirstOrdering <$> e) -nullsLast_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax syntax-           => QOrd syntax s a-           -> QOrd syntax s a-nullsLast_ (QExpr e) = QExpr (nullsLastOrdering <$> e)+nullsLast_ :: IsSql2003OrderingElementaryOLAPOperationsSyntax (BeamSqlBackendOrderingSyntax be)+           => QOrd be s a -> QOrd be s a+nullsLast_ (QOrd e) = QOrd (nullsLastOrdering <$> e)  -- | Produce a 'QOrd' corresponding to a SQL @ASC@ ordering-asc_ :: forall syntax s a. IsSql92OrderingSyntax syntax-     => QExpr (Sql92OrderingExpressionSyntax syntax) s a-     -> QOrd syntax s a-asc_ (QExpr e) = QExpr (ascOrdering <$> e)+asc_ :: forall be s a+      . BeamSqlBackend be+     => QExpr be s a -> QOrd be s a+asc_ (QExpr e) = QOrd (ascOrdering <$> e)  -- | Produce a 'QOrd' corresponding to a SQL @DESC@ ordering-desc_ :: forall syntax s a. IsSql92OrderingSyntax syntax-      => QExpr (Sql92OrderingExpressionSyntax syntax) s a-      -> QOrd syntax s a-desc_ (QExpr e) = QExpr (descOrdering <$> e)+desc_ :: forall be s a+       . BeamSqlBackend be+      => QExpr be s a -> QOrd be s a+desc_ (QExpr e) = QOrd (descOrdering <$> e)  -- * Subqueries @@ -808,24 +744,19 @@     --   'PrimaryKey' filled with 'Nothing'.     nothing_ :: b -instance ( IsSql92ExpressionSyntax syntax-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull) =>-    SqlJustable (QExpr syntax s a) (QExpr syntax s (Maybe a)) where+instance BeamSqlBackend be =>+    SqlJustable (QExpr be s a) (QExpr be s (Maybe a)) where      just_ (QExpr e) = QExpr e     nothing_ = QExpr (pure (valueE (sqlValueSyntax SqlNull))) -instance {-# OVERLAPPING #-} ( Table t-                             , IsSql92ExpressionSyntax syntax-                             , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull ) =>-    SqlJustable (PrimaryKey t (QExpr syntax s)) (PrimaryKey t (Nullable (QExpr syntax s))) where+instance {-# OVERLAPPING #-} ( Table t, BeamSqlBackend be ) =>+    SqlJustable (PrimaryKey t (QExpr be s)) (PrimaryKey t (Nullable (QExpr be s))) where     just_ = changeBeamRep (\(Columnar' q) -> Columnar' (just_ q))     nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' nothing_) (primaryKey (tblSkeleton :: TableSkeleton t)) -instance {-# OVERLAPPING #-} ( Table t-                             , IsSql92ExpressionSyntax syntax-                             , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) SqlNull ) =>-    SqlJustable (t (QExpr syntax s)) (t (Nullable (QExpr syntax s))) where+instance {-# OVERLAPPING #-} ( Table t, BeamSqlBackend be ) =>+    SqlJustable (t (QExpr be s)) (t (Nullable (QExpr be s))) where     just_ = changeBeamRep (\(Columnar' q) -> Columnar' (just_ q))     nothing_ = changeBeamRep (\(Columnar' _) -> Columnar' nothing_) (tblSkeleton :: TableSkeleton t) @@ -839,53 +770,53 @@  -- * Nullable checking -data QIfCond context expr s a = QIfCond (QGenExpr context expr s SqlBool) (QGenExpr context expr s a)-newtype QIfElse context expr s a = QIfElse (QGenExpr context expr s a)+data QIfCond context be s a = QIfCond (QGenExpr context be s SqlBool) (QGenExpr context be s a)+newtype QIfElse context be s a = QIfElse (QGenExpr context be s a) -then_ :: QGenExpr context expr s Bool -> QGenExpr context expr s a -> QIfCond context expr s a+then_ :: QGenExpr context be s Bool -> QGenExpr context be s a -> QIfCond context be s a then_ cond res = QIfCond (sqlBool_ cond) res -then_' :: QGenExpr context expr s SqlBool -> QGenExpr context expr s a -> QIfCond context expr s a+then_' :: QGenExpr context be s SqlBool -> QGenExpr context be s a -> QIfCond context be s a then_' cond res = QIfCond cond res -else_ :: QGenExpr context expr s a -> QIfElse context expr s a+else_ :: QGenExpr context be s a -> QIfElse context be s a else_ = QIfElse -if_ :: IsSql92ExpressionSyntax expr =>-       [ QIfCond context expr s a ]-    -> QIfElse context expr s a-    -> QGenExpr context expr s a+if_ :: BeamSqlBackend be+    => [ QIfCond context be s a ]+    -> QIfElse context be s a+    -> QGenExpr context be s a if_ conds (QIfElse (QExpr elseExpr)) =   QExpr (\tbl -> caseE (map (\(QIfCond (QExpr cond) (QExpr res)) -> (cond tbl, res tbl)) conds) (elseExpr tbl))  -- | SQL @COALESCE@ support-coalesce_ :: IsSql92ExpressionSyntax expr-          => [ QGenExpr ctxt expr s (Maybe a) ] -> QGenExpr ctxt expr s a -> QGenExpr ctxt expr s a+coalesce_ :: BeamSqlBackend be+          => [ QGenExpr ctxt be s (Maybe a) ] -> QGenExpr ctxt be s a -> QGenExpr ctxt be s a coalesce_ qs (QExpr onNull) =   QExpr $ do     onNull' <- onNull     coalesceE . (<> [onNull']) <$> mapM (\(QExpr q) -> q) qs  -- | Converta a 'Maybe' value to a concrete value, by suppling a default-fromMaybe_ :: IsSql92ExpressionSyntax expr-           =>  QGenExpr ctxt expr s a -> QGenExpr ctxt expr s (Maybe a) -> QGenExpr ctxt expr s a+fromMaybe_ :: BeamSqlBackend be+           => QGenExpr ctxt be s a -> QGenExpr ctxt be s (Maybe a) -> QGenExpr ctxt be s a fromMaybe_ onNull q = coalesce_ [q] onNull  -- | Type class for anything which can be checked for null-ness. This includes 'QExpr (Maybe a)' as -- well as 'Table's or 'PrimaryKey's over 'Nullable QExpr'.-class IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax a nonNullA s | a s -> syntax, a -> nonNullA, a -> s, nonNullA -> s where+class BeamSqlBackend be => SqlDeconstructMaybe be a nonNullA s | a s -> be, a -> nonNullA, a -> s, nonNullA -> s where     -- | Returns a 'QExpr' that evaluates to true when the first argument is not null-    isJust_ :: a -> QGenExpr ctxt syntax s Bool+    isJust_ :: a -> QGenExpr ctxt be s Bool      -- | Returns a 'QExpr' that evaluates to true when the first argument is null-    isNothing_ :: a -> QGenExpr ctxt syntax s Bool+    isNothing_ :: a -> QGenExpr ctxt be s Bool      -- | Given an object (third argument) which may or may not be null, return the default value if     -- null (first argument), or transform the value that could be null to yield the result of the     -- expression (second argument)-    maybe_ :: QGenExpr ctxt syntax s y -> (nonNullA -> QGenExpr ctxt syntax s y) -> a -> QGenExpr ctxt syntax s y+    maybe_ :: QGenExpr ctxt be s y -> (nonNullA -> QGenExpr ctxt be s y) -> a -> QGenExpr ctxt be s y -instance IsSql92ExpressionSyntax syntax => SqlDeconstructMaybe syntax (QGenExpr ctxt syntax s (Maybe x)) (QGenExpr ctxt syntax s x) s where+instance BeamSqlBackend be => SqlDeconstructMaybe be (QGenExpr ctxt be s (Maybe x)) (QGenExpr ctxt be s x) s where     isJust_ (QExpr x) = QExpr (isNotNullE <$> x)     isNothing_ (QExpr x) = QExpr (isNullE <$> x) @@ -893,10 +824,8 @@         let QExpr onJust' = onJust (QExpr e)         in QExpr (\tbl -> caseE [(isNotNullE (e tbl), onJust' tbl)] (onNothing tbl)) -instance ( IsSql92ExpressionSyntax syntax-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool-         , Beamable t )-    => SqlDeconstructMaybe syntax (t (Nullable (QGenExpr ctxt syntax s))) (t (QGenExpr ctxt syntax s)) s where+instance ( BeamSqlBackend be, Beamable t)+    => SqlDeconstructMaybe be (t (Nullable (QGenExpr ctxt be s))) (t (QGenExpr ctxt be s)) s where     isJust_ t = allE (allBeamValues (\(Columnar' e) -> isJust_ e) t)     isNothing_ t = allE (allBeamValues (\(Columnar' e) -> isNothing_ e) t)     maybe_ (QExpr onNothing) onJust tbl =

@@ -45,6 +45,7 @@   , IsCustomSqlSyntax(..) ) where  import           Database.Beam.Query.Internal+import           Database.Beam.Backend.SQL import           Database.Beam.Backend.SQL.Builder  import           Data.ByteString (ByteString)@@ -77,31 +78,35 @@   customExprSyntax (SqlSyntaxBuilderCustom bs) = SqlSyntaxBuilder (byteString bs)   renderSyntax = SqlSyntaxBuilderCustom . toStrict . toLazyByteString . buildSql -newtype CustomSqlSnippet syntax = CustomSqlSnippet (T.Text -> CustomSqlSyntax syntax)-instance IsCustomSqlSyntax syntax => Semigroup (CustomSqlSnippet syntax) where+newtype CustomSqlSnippet be = CustomSqlSnippet (T.Text -> CustomSqlSyntax (BeamSqlBackendExpressionSyntax be))+instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => Semigroup (CustomSqlSnippet be) where   (<>) = mappend-instance IsCustomSqlSyntax syntax => Monoid (CustomSqlSnippet syntax) where+instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => Monoid (CustomSqlSnippet be) where   mempty = CustomSqlSnippet (pure mempty)   mappend (CustomSqlSnippet a) (CustomSqlSnippet b) =     CustomSqlSnippet $ \pfx -> a pfx <> b pfx-instance IsCustomSqlSyntax syntax => IsString (CustomSqlSnippet syntax) where+instance IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be) => IsString (CustomSqlSnippet be) where   fromString s = CustomSqlSnippet $ \_ -> fromString s  class IsCustomExprFn fn res | res -> fn where   customExpr_ :: fn -> res -instance IsCustomSqlSyntax syntax => IsCustomExprFn (CustomSqlSnippet syntax) (QGenExpr ctxt syntax s res) where+type BeamSqlBackendHasCustomSyntax be = IsCustomSqlSyntax (BeamSqlBackendExpressionSyntax be)++instance BeamSqlBackendHasCustomSyntax be => IsCustomExprFn (CustomSqlSnippet be) (QGenExpr ctxt be s res) where   customExpr_ (CustomSqlSnippet mkSyntax) = QExpr (customExprSyntax . mkSyntax)-instance (IsCustomExprFn a res, IsCustomSqlSyntax syntax) => IsCustomExprFn (CustomSqlSnippet syntax -> a) (QGenExpr ctxt syntax s r -> res) where++instance (IsCustomExprFn a res, BeamSqlBackendHasCustomSyntax be) =>+  IsCustomExprFn (CustomSqlSnippet be -> a) (QGenExpr ctxt be s r -> res) where   customExpr_ fn (QExpr e) = customExpr_ $ fn (CustomSqlSnippet (renderSyntax . e))  -- | Force a 'QGenExpr' to be typed as a value expression (a 'QExpr'). Useful --   for getting around type-inference errors with supplying the entire type.-valueExpr_ :: QExpr syntax s a -> QExpr syntax s a+valueExpr_ :: QExpr be s a -> QExpr be s a valueExpr_ = id  -- | Force a 'QGenExpr' to be typed as an aggregate. Useful for defining custom --   aggregates for use in 'aggregate_'.-agg_ :: QAgg syntax s a -> QAgg syntax s a+agg_ :: QAgg be s a -> QAgg be s a agg_ = id 

@@ -0,0 +1,115 @@+{-# LANGUAGE UndecidableInstances #-}+module Database.Beam.Query.DataTypes where++import Database.Beam.Backend.SQL+import Database.Beam.Query.Internal++import Data.Text (Text)+import Data.Time (LocalTime, Day, TimeOfDay)+import Data.Scientific (Scientific)+import Data.Typeable (Typeable)+import Data.Vector (Vector)++-- | A data type in a given 'IsSql92DataTypeSyntax' which describes a SQL type+-- mapping to the Haskell type @a@+newtype DataType be a = DataType (BeamSqlBackendCastTargetSyntax be)++instance Sql92DisplaySyntax (BeamSqlBackendCastTargetSyntax be) => Show (DataType be a) where+  show (DataType syntax) = "DataType (" ++ displaySyntax syntax ++ ")"+deriving instance Eq (BeamSqlBackendCastTargetSyntax be) => Eq (DataType be a)++-- | Cast a value to a specific data type, specified using 'DataType'.+--+-- Note: this may fail at run-time if the cast is invalid for a particular value+cast_ :: BeamSqlBackend be => QGenExpr ctxt be s a -> DataType be b -> QGenExpr ctxt be s b+cast_ (QExpr e) (DataType dt) = QExpr (castE <$> e <*> pure dt)++-- ** Data types++-- | SQL92 @INTEGER@ data type+int :: (BeamSqlBackend be, Integral a) => DataType be a+int = DataType intType++-- | SQL92 @SMALLINT@ data type+smallint :: (BeamSqlBackend be, Integral a) => DataType be a+smallint = DataType smallIntType++-- | SQL2008 Optional @BIGINT@ data type+bigint :: ( BeamSqlBackend be, BeamSqlT071Backend be, Integral a )+       => DataType be a+bigint = DataType bigIntType++-- TODO is Integer the right type to use here?+-- | SQL2003 Optional @BINARY@ data type+binary :: ( BeamSqlBackend be, BeamSqlT021Backend be )+       => Maybe Word -> DataType be Integer+binary prec = DataType (binaryType prec)++-- | SQL2003 Optional @VARBINARY@ data type+varbinary :: ( BeamSqlBackend be, BeamSqlT021Backend be )+          => Maybe Word -> DataType be Integer+varbinary prec = DataType (varBinaryType prec)++-- TODO should this be Day or something?+-- | SQL92 @DATE@ data type+date :: BeamSqlBackend be => DataType be Day+date = DataType dateType++-- | SQL92 @CHAR@ data type+char :: BeamSqlBackend be => Maybe Word -> DataType be Text+char prec = DataType (charType prec Nothing)++-- | SQL92 @VARCHAR@ data type+varchar :: BeamSqlBackend be => Maybe Word -> DataType be Text+varchar prec = DataType (varCharType prec Nothing)++-- | SQL92 @NATIONAL CHARACTER VARYING@ data type+nationalVarchar :: BeamSqlBackend be => Maybe Word -> DataType be Text+nationalVarchar prec = DataType (nationalVarCharType prec)++-- | SQL92 @NATIONAL CHARACTER@ data type+nationalChar :: BeamSqlBackend be => Maybe Word -> DataType be Text+nationalChar prec = DataType (nationalCharType prec)++-- | SQL92 @DOUBLE@ data type+double :: BeamSqlBackend be => DataType be Double+double = DataType doubleType++-- | SQL92 @NUMERIC@ data type+numeric :: BeamSqlBackend be => Maybe (Word, Maybe Word) -> DataType be Scientific+numeric x = DataType (numericType x)++-- | SQL92 @TIMESTAMP WITH TIME ZONE@ data type+timestamptz :: BeamSqlBackend be => DataType be LocalTime+timestamptz = DataType (timestampType Nothing True)++-- | SQL92 @TIMESTAMP WITHOUT TIME ZONE@ data type+timestamp :: BeamSqlBackend be => DataType be LocalTime+timestamp = DataType (timestampType Nothing False)++-- | SQL92 @TIME@ data type+time :: BeamSqlBackend be => Maybe Word -> DataType be TimeOfDay+time prec = DataType (timeType prec False)++-- | SQL99 @BOOLEAN@ data type+boolean :: BeamSql99DataTypeBackend be => DataType be Bool+boolean = DataType booleanType++-- | SQL99 @CLOB@ data type+characterLargeObject :: BeamSql99DataTypeBackend be => DataType be Text+characterLargeObject = DataType characterLargeObjectType++-- | SQL99 @BLOB@ data type+binaryLargeObject :: BeamSql99DataTypeBackend be => DataType be Text+binaryLargeObject = DataType binaryLargeObjectType++-- | SQL99 array data types+array :: (Typeable a, BeamSql99DataTypeBackend be)+      => DataType be a -> Int+      -> DataType be (Vector a)+array (DataType ty) sz = DataType (arrayType ty sz)++-- | Haskell requires 'DataType's to match exactly. Use this function to convert+-- a 'DataType' that expects a concrete value to one expecting a 'Maybe'+maybeType :: DataType be a -> DataType be (Maybe a)+maybeType (DataType sqlTy) = DataType sqlTy

@@ -41,68 +41,74 @@  import Database.Beam.Backend.SQL -ntile_ :: (Integral a, IsSql2003NtileExpressionSyntax syntax)-       => QExpr syntax s Int -> QAgg syntax s a+ntile_ :: (BeamSqlBackend be, BeamSqlT614Backend be)+       => QExpr be s Int -> QAgg be s a ntile_ (QExpr a) = QExpr (ntileE <$> a) -lead1_, lag1_ :: IsSql2003LeadAndLagExpressionSyntax syntax-              => QExpr syntax s a -> QAgg syntax s a+lead1_, lag1_+  :: (BeamSqlBackend be, BeamSqlT615Backend be)+  => QExpr be s a -> QAgg be s a lead1_ (QExpr a) = QExpr (leadE <$> a <*> pure Nothing <*> pure Nothing) lag1_ (QExpr a) = QExpr (lagE <$> a <*> pure Nothing <*> pure Nothing) -lead_, lag_ :: IsSql2003LeadAndLagExpressionSyntax syntax-            => QExpr syntax s a -> QExpr syntax s Int -> QAgg syntax s a+lead_, lag_+  :: (BeamSqlBackend be, BeamSqlT615Backend be)+  => QExpr be s a -> QExpr be s Int -> QAgg be s a lead_ (QExpr a) (QExpr n) = QExpr (leadE <$> a <*> (Just <$> n) <*> pure Nothing) lag_ (QExpr a) (QExpr n) = QExpr (lagE <$> a <*> (Just <$> n) <*> pure Nothing)  leadWithDefault_, lagWithDefault_-  :: IsSql2003LeadAndLagExpressionSyntax syntax-  => QExpr syntax s a -> QExpr syntax s Int -> QExpr syntax s a-  -> QAgg syntax s a+  :: (BeamSqlBackend be, BeamSqlT615Backend be)+  => QExpr be s a -> QExpr be s Int -> QExpr be s a+  -> QAgg be s a leadWithDefault_ (QExpr a) (QExpr n) (QExpr def) =   QExpr (leadE <$> a <*> fmap Just n <*> fmap Just def) lagWithDefault_ (QExpr a) (QExpr n) (QExpr def) =   QExpr (lagE <$> a <*> fmap Just n <*> fmap Just def)  -- TODO the first 'a' should be nullable, and the second one not-firstValue_, lastValue_ :: IsSql2003FirstValueAndLastValueExpressionSyntax syntax-                        => QExpr syntax s a -> QAgg syntax s a+firstValue_, lastValue_+  :: (BeamSqlBackend be, BeamSqlT616Backend be)+  => QExpr be s a -> QAgg be s a firstValue_ (QExpr a) = QExpr (firstValueE <$> a) lastValue_ (QExpr a) = QExpr (lastValueE <$> a)  -- TODO see comment for 'firstValue_' and 'lastValue_'-nthValue_ :: IsSql2003NthValueExpressionSyntax syntax-          => QExpr syntax s a -> QExpr syntax s Int -> QAgg syntax s a+nthValue_+  :: (BeamSqlBackend be, BeamSqlT618Backend be)+  => QExpr be s a -> QExpr be s Int -> QAgg be s a nthValue_ (QExpr a) (QExpr n) = QExpr (nthValueE <$> a <*> n) -ln_, exp_, sqrt_ :: (Floating a, IsSql2003EnhancedNumericFunctionsExpressionSyntax syntax)-                 => QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a+ln_, exp_, sqrt_+  :: (Floating a, BeamSqlBackend be, BeamSqlT621Backend be)+  => QGenExpr ctxt be s a -> QGenExpr ctxt be s a ln_ (QExpr a) = QExpr (lnE <$> a) exp_ (QExpr a) = QExpr (expE <$> a) sqrt_ (QExpr a) = QExpr (sqrtE <$> a) -ceiling_, floor_ :: (RealFrac a, Integral b, IsSql2003EnhancedNumericFunctionsExpressionSyntax syntax)-                 => QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s b+ceiling_, floor_+  :: (RealFrac a, Integral b, BeamSqlBackend be, BeamSqlT621Backend be)+  => QGenExpr ctxt be s a -> QGenExpr ctxt be s b ceiling_ (QExpr a) = QExpr (ceilE <$> a) floor_ (QExpr a) = QExpr (floorE <$> a)  infixr 8 **.-(**.) :: (Floating a, IsSql2003EnhancedNumericFunctionsExpressionSyntax syntax)-      => QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a+(**.) :: (Floating a, BeamSqlBackend be, BeamSqlT621Backend be)+      => QGenExpr ctxt be s a -> QGenExpr ctxt be s a -> QGenExpr ctxt be s a QExpr a **. QExpr b = QExpr (powerE <$> a <*> b)  stddevPopOver_, stddevSampOver_, varPopOver_, varSampOver_-  :: (Num a, Floating b, IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax syntax)-  => Maybe (Sql92AggregationSetQuantifierSyntax syntax) -> QExpr syntax s a-  -> QAgg syntax s b+  :: (Num a, Floating b, BeamSqlBackend be, BeamSqlT621Backend be)+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be) -> QExpr be s a+  -> QAgg be s b stddevPopOver_ q (QExpr x) = QExpr (stddevPopE q <$> x) stddevSampOver_ q (QExpr x) = QExpr (stddevSampE q <$> x) varPopOver_ q (QExpr x) = QExpr (varPopE q <$> x) varSampOver_ q (QExpr x) = QExpr (varSampE q <$> x)  stddevPop_, stddevSamp_, varPop_, varSamp_-  :: (Num a, Floating b, IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax syntax)-  => QExpr syntax s a -> QAgg syntax s b+  :: (Num a, Floating b, BeamSqlBackend be, BeamSqlT621Backend be)+  => QExpr be s a -> QAgg be s b stddevPop_ = stddevPopOver_ allInGroup_ stddevSamp_ = stddevSampOver_ allInGroup_ varPop_ = varPopOver_ allInGroup_@@ -111,9 +117,9 @@ covarPopOver_, covarSampOver_, corrOver_, regrSlopeOver_, regrInterceptOver_,   regrCountOver_, regrRSquaredOver_, regrAvgYOver_, regrAvgXOver_,   regrSXXOver_, regrSXYOver_, regrSYYOver_-  :: (Num a, Floating b, IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax syntax)-  => Maybe (Sql92AggregationSetQuantifierSyntax syntax) -> QExpr syntax s a -> QExpr syntax s a-  -> QExpr syntax s b+  :: (Num a, Floating b, BeamSqlBackend be, BeamSqlT621Backend be)+  => Maybe (BeamSqlBackendAggregationQuantifierSyntax be) -> QExpr be s a -> QExpr be s a+  -> QExpr be s b covarPopOver_ q (QExpr x) (QExpr y) = QExpr (covarPopE q <$> x <*> y) covarSampOver_ q (QExpr x) (QExpr y) = QExpr (covarSampE q <$> x <*> y) corrOver_ q (QExpr x) (QExpr y) = QExpr (corrE q <$> x <*> y)@@ -129,8 +135,8 @@  covarPop_, covarSamp_, corr_, regrSlope_, regrIntercept_, regrCount_,   regrRSquared_, regrAvgY_, regrAvgX_, regrSXX_, regrSXY_, regrSYY_-  :: (Num a, Floating b, IsSql2003EnhancedNumericFunctionsAggregationExpressionSyntax syntax)-  => QExpr syntax s a -> QExpr syntax s a -> QExpr syntax s b+  :: (Num a, Floating b, BeamSqlBackend be, BeamSqlT621Backend be)+  => QExpr be s a -> QExpr be s a -> QExpr be s b covarPop_ = covarPopOver_ allInGroup_ covarSamp_ = covarSampOver_ allInGroup_ corr_ = corrOver_ allInGroup_

@@ -0,0 +1,61 @@+module Database.Beam.Query.Extract+    ( -- * SQL @EXTRACT@ support++      ExtractField(..),++      extract_,++      -- ** SQL92 fields+      hour_, minutes_, seconds_,+      year_, month_, day_,++      HasSqlTime, HasSqlDate+    ) where++import Database.Beam.Query.Internal ( QGenExpr(..) )++import Database.Beam.Backend.SQL ( BeamSqlBackend, BeamSqlBackendSyntax )+import Database.Beam.Backend.SQL.SQL92 ( Sql92ExtractFieldSyntax+                                       , IsSql92ExpressionSyntax(..)+                                       , IsSql92ExtractFieldSyntax(..) )++import Data.Time (LocalTime, UTCTime, TimeOfDay, Day)++-- | A field that can be extracted from SQL expressions of type 'tgt'+-- that results in a type 'a', in backend 'be'.+newtype ExtractField be tgt a+    = ExtractField (Sql92ExtractFieldSyntax (BeamSqlBackendSyntax be))++-- | Extracts the given field from the target expression+extract_ :: BeamSqlBackend be+         => ExtractField be tgt a -> QGenExpr ctxt be s tgt -> QGenExpr cxt be s a+extract_ (ExtractField field) (QExpr expr) =+    QExpr (extractE field <$> expr)++-- | Type-class for types that contain a time component+class HasSqlTime tgt+instance HasSqlTime LocalTime+instance HasSqlTime UTCTime+instance HasSqlTime TimeOfDay++-- | Extracts the hours, minutes, or seconds from any timestamp or+-- time field+hour_, minutes_, seconds_+    :: ( BeamSqlBackend be, HasSqlTime tgt )+    => ExtractField be tgt Double+hour_    = ExtractField hourField+minutes_ = ExtractField minutesField+seconds_ = ExtractField secondsField++-- | Type-class for types that contain a date component+class HasSqlDate tgt+instance HasSqlDate LocalTime+instance HasSqlDate UTCTime+instance HasSqlDate Day++year_, month_, day_+    :: ( BeamSqlBackend be, HasSqlDate tgt )+    => ExtractField be tgt Double+year_  = ExtractField yearField+month_ = ExtractField monthField+day_   = ExtractField dayField

@@ -8,11 +8,13 @@ import           Database.Beam.Backend.SQL import           Database.Beam.Schema.Tables +import qualified Data.DList as DList+import           Data.Functor.Const import           Data.String import qualified Data.Text as T-import qualified Data.DList as DList import           Data.Typeable import           Data.Vector.Sized (Vector)+import qualified Data.Vector.Sized as VS #if !MIN_VERSION_base(4, 11, 0) import           Data.Semigroup #endif@@ -24,89 +26,92 @@ import           GHC.TypeLits import           GHC.Types -type ProjectibleInSelectSyntax syntax a =-  ( IsSql92SelectSyntax syntax-  , Eq (Sql92SelectExpressionSyntax syntax)-  , Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax) ~ Sql92SelectExpressionSyntax syntax-  , Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax-  , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a-  , ProjectibleValue (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a)+type ProjectibleInBackend be a =+  ( -- Eq (Sql92SelectExpressionSyntax syntax)+    Projectible be a+  , ProjectibleValue be a )  type TablePrefix = T.Text -data QF select (db :: (* -> *) -> *) s next where-  QDistinct :: Projectible (Sql92SelectExpressionSyntax select) r-            => (r -> WithExprContext (Sql92SelectTableSetQuantifierSyntax (Sql92SelectSelectTableSyntax select)))-            -> QM select db s r-            -> (r -> next)-            -> QF select db s next+data QF be (db :: (* -> *) -> *) s next where+  QDistinct :: Projectible be r+            => (r -> WithExprContext (BeamSqlBackendSetQuantifierSyntax be))+            -> QM be db s r -> (r -> next) -> QF be db s next -  QAll :: Beamable table-       => (TablePrefix -> T.Text -> Sql92SelectFromSyntax select) -> TableSettings table-       -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))-       -> ((T.Text, table (QExpr (Sql92SelectExpressionSyntax select) s)) -> next) -> QF select db s next+  QAll :: Projectible be r+       => (TablePrefix -> T.Text -> BeamSqlBackendFromSyntax be)+       -> (T.Text -> r)+       -> (r -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))+       -> ((T.Text, r) -> next) -> QF be db s next -  QArbitraryJoin :: Projectible (Sql92SelectExpressionSyntax select) r-                 => QM select db (QNested s) r-                 -> (Sql92SelectFromSyntax select -> Sql92SelectFromSyntax select ->-                     Maybe (Sql92FromExpressionSyntax (Sql92SelectFromSyntax select)) ->-                     Sql92SelectFromSyntax select)-                 -> (r -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))+  QArbitraryJoin :: Projectible be r+                 => QM be db (QNested s) r+                 -> (BeamSqlBackendFromSyntax be -> BeamSqlBackendFromSyntax be ->+                     Maybe (BeamSqlBackendExpressionSyntax be) ->+                     BeamSqlBackendFromSyntax be)+                 -> (r -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))                  -> (r -> next)-                 -> QF select db s next-  QTwoWayJoin :: ( Projectible (Sql92SelectExpressionSyntax select) a-                 , Projectible (Sql92SelectExpressionSyntax select) b )-              => QM select db (QNested s) a-              -> QM select db (QNested s) b-              -> (Sql92SelectFromSyntax select -> Sql92SelectFromSyntax select ->-                   Maybe (Sql92FromExpressionSyntax (Sql92SelectFromSyntax select)) ->-                   Sql92SelectFromSyntax select)-              -> ((a, b) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))+                 -> QF be db s next+  QTwoWayJoin :: ( Projectible be a+                 , Projectible be b )+              => QM be db (QNested s) a+              -> QM be db (QNested s) b+              -> (BeamSqlBackendFromSyntax be -> BeamSqlBackendFromSyntax be ->+                  Maybe (BeamSqlBackendExpressionSyntax be) ->+                  BeamSqlBackendFromSyntax be)+              -> ((a, b) -> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))               -> ((a, b) -> next)-              -> QF select db s next+              -> QF be db s next -  QSubSelect :: Projectible (Sql92SelectExpressionSyntax select) r =>-                QM select db (QNested s) r -> (r -> next) -> QF select db s next-  QGuard :: WithExprContext (Sql92SelectExpressionSyntax select) -> next -> QF select db s next+  QSubSelect :: Projectible be r+             => QM be db (QNested s) r -> (r -> next)+             -> QF be db s next -  QLimit :: Projectible (Sql92SelectExpressionSyntax select) r => Integer -> QM select db (QNested s) r -> (r -> next) -> QF select db s next-  QOffset :: Projectible (Sql92SelectExpressionSyntax select) r => Integer -> QM select db (QNested s) r -> (r -> next) -> QF select db s next+  QGuard :: WithExprContext (BeamSqlBackendExpressionSyntax be) -> next -> QF be db s next -  QUnion ::Projectible (Sql92SelectExpressionSyntax select) r =>  Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next-  QIntersect :: Projectible (Sql92SelectExpressionSyntax select) r => Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next-  QExcept :: Projectible (Sql92SelectExpressionSyntax select) r => Bool -> QM select db (QNested s) r -> QM select db (QNested s) r -> (r -> next) -> QF select db s next-  QOrderBy :: Projectible (Sql92SelectExpressionSyntax select) r =>-              (r -> WithExprContext [ Sql92SelectOrderingSyntax select ])-           -> QM select db (QNested s) r -> (r -> next) -> QF select db s next+  QLimit  :: Projectible be r => Integer -> QM be db (QNested s) r -> (r -> next) -> QF be db s next+  QOffset :: Projectible be r => Integer -> QM be db (QNested s) r -> (r -> next) -> QF be db s next -  QWindowOver :: ( ProjectibleWithPredicate WindowFrameContext (Sql2003ExpressionWindowFrameSyntax (Sql92SelectExpressionSyntax select)) window-                 , Projectible (Sql92SelectExpressionSyntax select) r-                 , Projectible (Sql92SelectExpressionSyntax select) a )+  QSetOp :: Projectible be r+         => (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)+         -> QM be db (QNested s) r+         -> QM be db (QNested s) r -> (r -> next)+         -> QF be db s next++  QOrderBy :: Projectible be r+           => (r -> WithExprContext [ BeamSqlBackendOrderingSyntax be ])+           -> QM be db (QNested s) r -> (r -> next) -> QF be db s next++  QWindowOver :: ( ProjectibleWithPredicate WindowFrameContext be (WithExprContext (BeamSqlBackendWindowFrameSyntax' be)) window+                 , Projectible be r+                 , Projectible be a )               => (r -> window) -> (r -> window -> a)-              -> QM select db (QNested s) r -> (a -> next) -> QF select db s next-  QAggregate :: ( Projectible (Sql92SelectExpressionSyntax select) grouping-                , Projectible (Sql92SelectExpressionSyntax select) a ) =>-                (a -> TablePrefix -> (Maybe (Sql92SelectGroupingSyntax select), grouping)) ->-                QM select db (QNested s) a ->-                (grouping -> next) -> QF select db s next+              -> QM be db (QNested s) r -> (a -> next) -> QF be db s next +  QAggregate :: ( Projectible be grouping+                , Projectible be a )+             => (a -> TablePrefix -> (Maybe (BeamSqlBackendGroupingSyntax be), grouping))+             -> QM be db (QNested s) a+             -> (grouping -> next)+             -> QF be db s next+   -- Force the building of a select statement, using the given builder-  QForceSelect :: Projectible (Sql92SelectExpressionSyntax select) r-               => (r -> Sql92SelectSelectTableSyntax select -> [ Sql92SelectOrderingSyntax select ] ->-                   Maybe Integer -> Maybe Integer -> select)-               -> QM select db (QNested s) r+  QForceSelect :: Projectible be r+               => (r -> BeamSqlBackendSelectTableSyntax be -> [ BeamSqlBackendOrderingSyntax be ] ->+                   Maybe Integer -> Maybe Integer -> BeamSqlBackendSelectSyntax be)+               -> QM be db (QNested s) r                -> (r -> next)-               -> QF select db s next+               -> QF be db s next -deriving instance Functor (QF select db s)+deriving instance Functor (QF be db s) -type QM select db s = F (QF select db s)+type QM be db s = F (QF be db s)  -- | The type of queries over the database `db` returning results of type `a`. -- The `s` argument is a threading argument meant to restrict cross-usage of -- `QExpr`s. 'syntax' represents the SQL syntax that this query is building.-newtype Q syntax (db :: (* -> *) -> *) s a-  = Q { runQ :: QM syntax db s a }+newtype Q be (db :: (* -> *) -> *) s a+  = Q { runQ :: QM be db s a }     deriving (Monad, Applicative, Functor)  data QInternal@@ -114,21 +119,23 @@  data QField s ty   = QField-  { qFieldShouldQualify :: Bool-  , qFieldTblName :: T.Text-  , qFieldName    :: T.Text }+  { qFieldShouldQualify :: !Bool+  , qFieldTblName       :: !T.Text+  , qFieldName          :: !T.Text }   deriving (Show, Eq, Ord) -newtype QAssignment fieldName expr s-  = QAssignment [(fieldName, expr)]-  deriving (Show, Eq, Ord, Monoid, Semigroup)+newtype QAssignment be s+  = QAssignment [(BeamSqlBackendFieldNameSyntax be, BeamSqlBackendExpressionSyntax be)]+  deriving (Monoid, Semigroup) +newtype QFieldAssignment be tbl a+  = QFieldAssignment (forall s. tbl (QExpr be s) -> Maybe (QExpr be s a))+ -- * QGenExpr type  data QAggregateContext data QGroupingContext data QValueContext-data QOrderingContext data QWindowingContext data QWindowFrameContext @@ -145,18 +152,18 @@ --   's' is a state threading parameter that prevents 'QExpr's from incompatible --   sources to be combined. For example, this is used to prevent monadic joins --   from depending on the result of previous joins (so-called @LATERAL@ joins).-newtype QGenExpr context syntax s t = QExpr (TablePrefix -> syntax)+newtype QGenExpr context be s t = QExpr (TablePrefix -> BeamSqlBackendExpressionSyntax be)+newtype QOrd be s t = QOrd (TablePrefix -> BeamSqlBackendOrderingSyntax be)+ type WithExprContext a = TablePrefix -> a  -- | 'QExpr's represent expressions not containing aggregates. type QExpr = QGenExpr QValueContext type QAgg = QGenExpr QAggregateContext-type QOrd = QGenExpr QOrderingContext type QWindowExpr = QGenExpr QWindowingContext-type QWindowFrame = QGenExpr QWindowFrameContext type QGroupExpr = QGenExpr QGroupingContext --deriving instance Show syntax => Show (QGenExpr context syntax s t)-instance Eq syntax => Eq (QGenExpr context syntax s t) where+instance BeamSqlBackend be => Eq (QGenExpr context be s t) where   QExpr a == QExpr b = a "" == b ""  instance Retaggable (QGenExpr ctxt expr s) (QGenExpr ctxt expr s t) where@@ -164,28 +171,27 @@   retag f e = case f (Columnar' e) of                 Columnar' a -> a -newtype QWindow syntax s = QWindow (WithExprContext syntax)-newtype QFrameBounds syntax = QFrameBounds (Maybe syntax)-newtype QFrameBound syntax = QFrameBound syntax+newtype QWindow be s = QWindow (WithExprContext (BeamSqlBackendWindowFrameSyntax be))+newtype QFrameBounds be = QFrameBounds (Maybe (BeamSqlBackendWindowFrameBoundsSyntax be))+newtype QFrameBound be = QFrameBound (BeamSqlBackendWindowFrameBoundSyntax be) -qBinOpE :: forall syntax context s a b c. IsSql92ExpressionSyntax syntax =>-           (syntax -> syntax -> syntax)-        -> QGenExpr context syntax s a -> QGenExpr context syntax s b-        -> QGenExpr context syntax s c+qBinOpE :: BeamSqlBackend be+        => (BeamSqlBackendExpressionSyntax be ->+            BeamSqlBackendExpressionSyntax be ->+            BeamSqlBackendExpressionSyntax be)+        -> QGenExpr context be s a -> QGenExpr context be s b+        -> QGenExpr context be s c qBinOpE mkOpE (QExpr a) (QExpr b) = QExpr (mkOpE <$> a <*> b) -unsafeRetype :: QGenExpr ctxt syntax s a -> QGenExpr ctxt syntax s a'+unsafeRetype :: QGenExpr ctxt be s a -> QGenExpr ctxt be s a' unsafeRetype (QExpr v) = QExpr v -instance ( IsSql92ExpressionSyntax syntax-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) [Char] ) =>-    IsString (QGenExpr context syntax s T.Text) where+instance ( BeamSqlBackend backend, BeamSqlBackendCanSerialize backend [Char] ) =>+    IsString (QGenExpr context backend s T.Text) where     fromString = QExpr . pure . valueE . sqlValueSyntax-instance (Num a-         , IsSql92ExpressionSyntax syntax-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) a) =>-    Num (QGenExpr context syntax s a) where-    fromInteger x = let res :: QGenExpr context syntax s a+instance ( Num a, BeamSqlBackend be, BeamSqlBackendCanSerialize be a ) =>+    Num (QGenExpr context be s a) where+    fromInteger x = let res :: QGenExpr context be s a                         res = QExpr (pure (valueE (sqlValueSyntax (fromIntegral x :: a))))                     in res     QExpr a + QExpr b = QExpr (addE <$> a <*> b)@@ -195,22 +201,14 @@     abs (QExpr x) = QExpr (absE <$> x)     signum _ = error "signum: not defined for QExpr. Use CASE...WHEN" -instance ( Fractional a-         , IsSql92ExpressionSyntax syntax-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) a ) =>-  Fractional (QGenExpr context syntax s a) where+instance ( Fractional a, BeamSqlBackend be, BeamSqlBackendCanSerialize be a ) =>+  Fractional (QGenExpr context be s a) where    QExpr a / QExpr b = QExpr (divE <$> a <*> b)   recip = (1.0 /)    fromRational = QExpr . pure . valueE . sqlValueSyntax . (id :: a -> a) . fromRational --- * Aggregations--data Aggregation syntax s a-  = GroupAgg syntax --(Sql92ExpressionSyntax syntax)-  | ProjectAgg syntax --(Sql92ExpressionSyntax syntax)- -- * Sql Projections -- @@ -225,7 +223,6 @@ type instance ContextName QValueContext = "a value" type instance ContextName QWindowingContext = "a window expression" type instance ContextName QWindowFrameContext = "a window frame"-type instance ContextName QOrderingContext = "an ordering expression" type instance ContextName QAggregateContext = "an aggregate" type instance ContextName QGroupingContext = "an aggregate grouping" @@ -239,7 +236,6 @@ type family AggregateContextSuggestion a :: ErrorMessage where     AggregateContextSuggestion QValueContext = 'Text "Perhaps you forgot to wrap a value expression with 'group_'"     AggregateContextSuggestion QWindowingContext = 'Text "Perhaps you meant to use 'window_' instead of 'aggregate_'"-    AggregateContextSuggestion QOrderingContext = 'Text "You cannot use an ordering in an aggregate"     AggregateContextSuggestion b = 'Text ""  class Typeable context => ValueContext context@@ -265,14 +261,13 @@  type family ValueContextSuggestion a :: ErrorMessage where     ValueContextSuggestion QWindowingContext = 'Text "Use 'window_' to projecct aggregate expressions to the value level"-    ValueContextSuggestion QOrderingContext = 'Text "An ordering context cannot be used in a projection. Try removing the 'asc_' or 'desc_', or use 'orderBy_' to sort the result set"     ValueContextSuggestion QAggregateContext = ('Text "Aggregate functions and groupings cannot be contained in value expressions." :$$:                                                 'Text "Use 'aggregate_' to compute aggregations at the value level.")     ValueContextSuggestion QGroupingContext = ValueContextSuggestion QAggregateContext     ValueContextSuggestion _ = 'Text "" -type Projectible = ProjectibleWithPredicate AnyType-type ProjectibleValue = ProjectibleWithPredicate ValueContext+type Projectible be = ProjectibleWithPredicate AnyType be (WithExprContext (BeamSqlBackendExpressionSyntax' be))+type ProjectibleValue be = ProjectibleWithPredicate ValueContext be (WithExprContext (BeamSqlBackendExpressionSyntax' be))  class ThreadRewritable (s :: *) (a :: *) | a -> s where   type WithRewrittenThread s (s' :: *) a :: *@@ -420,89 +415,253 @@     , rewriteContext p d, rewriteContext p e, rewriteContext p f     , rewriteContext p g, rewriteContext p h ) -class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) syntax a | a -> syntax where-  project' :: Monad m => Proxy contextPredicate-           -> (forall context. contextPredicate context => Proxy context -> WithExprContext syntax -> m (WithExprContext syntax))+newtype BeamSqlBackendExpressionSyntax' be+  = BeamSqlBackendExpressionSyntax'+  { fromBeamSqlBackendExpressionSyntax :: BeamSqlBackendExpressionSyntax be+  }++newtype BeamSqlBackendWindowFrameSyntax' be+  = BeamSqlBackendWindowFrameSyntax'+  { fromBeamSqlBackendWindowFrameSyntax :: BeamSqlBackendWindowFrameSyntax be+  }++class ProjectibleWithPredicate (contextPredicate :: * -> Constraint) be res a | a -> be where+  project' :: Monad m => Proxy contextPredicate -> Proxy (be, res)+           -> (forall context. contextPredicate context =>+               Proxy context -> Proxy be -> res -> m res)            -> a -> m a-instance (Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate syntax (t (QGenExpr context syntax s)) where-  project' _ mutateM a =++  projectSkeleton' :: Monad m => Proxy contextPredicate -> Proxy (be, res)+                   -> (forall context. contextPredicate context =>+                       Proxy context -> Proxy be -> m res)+                   -> m a++instance (Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) (t (QGenExpr context be s)) where+  project' _ _ mutateM a =     zipBeamFieldsM (\(Columnar' (QExpr e)) _ ->-                      Columnar' . QExpr <$> mutateM (Proxy @context) e) a a-instance (Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate syntax (t (Nullable (QGenExpr context syntax s))) where-  project' _ mutateM a =+                      Columnar' . QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mutateM (Proxy @context) (Proxy @be) (BeamSqlBackendExpressionSyntax' . e)) a a++  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mkM (Proxy @context)(Proxy @be))+                   (tblSkeleton :: TableSkeleton t)+                   (tblSkeleton :: TableSkeleton t)++instance (Beamable t, contextPredicate context) => ProjectibleWithPredicate contextPredicate be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) (t (Nullable (QGenExpr context be s))) where+  project' _ _ mutateM a =     zipBeamFieldsM (\(Columnar' (QExpr e)) _ ->-                      Columnar' . QExpr <$> mutateM (Proxy @context) e) a a-instance ProjectibleWithPredicate WindowFrameContext syntax (QWindow syntax s) where-  project' _ mutateM (QWindow a) =-    QWindow <$> mutateM (Proxy @QWindowFrameContext) a-instance contextPredicate context => ProjectibleWithPredicate contextPredicate syntax (QGenExpr context syntax s a) where-  project' _ mkE (QExpr a) = QExpr <$> mkE (Proxy @context) a-instance ProjectibleWithPredicate contextPredicate syntax a => ProjectibleWithPredicate contextPredicate syntax [a] where-  project' p mkE as = traverse (project' p mkE) as-instance (ProjectibleWithPredicate contextPredicate syntax a, KnownNat n) => ProjectibleWithPredicate contextPredicate syntax (Vector n a) where-  project' p mkE as = traverse (project' p mkE) as-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b) where+                      Columnar' . QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mutateM (Proxy @context) (Proxy @be) (BeamSqlBackendExpressionSyntax' . e)) a a -  project' p mkE (a, b) = (,) <$> project' p mkE a <*> project' p mkE b-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c) where+  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mkM (Proxy @context)(Proxy @be))+                   (tblSkeleton :: TableSkeleton t)+                   (tblSkeleton :: TableSkeleton t) -  project' p mkE (a, b, c) = (,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c-         , ProjectibleWithPredicate contextPredicate syntax d ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c, d) where+-- instance ProjectibleWithPredicate WindowFrameContext be (QWindow be s) where+--   project' _ be mutateM (QWindow a) =+--     QWindow <$> mutateM (Proxy @QWindowFrameContext) be a -  project' p mkE (a, b, c, d) = (,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-                                      <*> project' p mkE d-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c-         , ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e) where+instance contextPredicate context => ProjectibleWithPredicate contextPredicate be (WithExprContext (BeamSqlBackendExpressionSyntax' be)) (QGenExpr context be s a) where+  project' _ _ mkE (QExpr a) = QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mkE (Proxy @context) (Proxy @be) (BeamSqlBackendExpressionSyntax' . a)+  projectSkeleton' _ _ mkM = QExpr . fmap fromBeamSqlBackendExpressionSyntax <$> mkM (Proxy @context) (Proxy @be) -  project' p mkE (a, b, c, d, e) = (,,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-                                          <*> project' p mkE d <*> project' p mkE e-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c-         , ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f) where+instance contextPredicate QWindowFrameContext => ProjectibleWithPredicate contextPredicate be (WithExprContext (BeamSqlBackendWindowFrameSyntax' be)) (QWindow be s) where+  project' _ _ mkW (QWindow w) = QWindow . fmap fromBeamSqlBackendWindowFrameSyntax <$> mkW (Proxy @QWindowFrameContext) (Proxy @be) (BeamSqlBackendWindowFrameSyntax' . w)+  projectSkeleton' _ _ mkM = QWindow . fmap fromBeamSqlBackendWindowFrameSyntax <$> mkM (Proxy @QWindowFrameContext) (Proxy @be) -  project' p mkE (a, b, c, d, e, f) = (,,,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-                                              <*> project' p mkE d <*> project' p mkE e <*> project' p mkE f-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c-         , ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f-         , ProjectibleWithPredicate contextPredicate syntax g ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f, g) where+-- instance ProjectibleWithPredicate contextPredicate be res a => ProjectibleWithPredicate contextPredicate be res [a] where+--   project' context be mkE as = traverse (project' context be mkE) as -  project' p mkE (a, b, c, d, e, f, g) =-    (,,,,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-             <*> project' p mkE d <*> project' p mkE e <*> project' p mkE f-             <*> project' p mkE g-instance ( ProjectibleWithPredicate contextPredicate syntax a, ProjectibleWithPredicate contextPredicate syntax b, ProjectibleWithPredicate contextPredicate syntax c-         , ProjectibleWithPredicate contextPredicate syntax d, ProjectibleWithPredicate contextPredicate syntax e, ProjectibleWithPredicate contextPredicate syntax f-         , ProjectibleWithPredicate contextPredicate syntax g, ProjectibleWithPredicate contextPredicate syntax h ) =>-  ProjectibleWithPredicate contextPredicate syntax (a, b, c, d, e, f, g, h) where+instance (ProjectibleWithPredicate contextPredicate be res a, KnownNat n) => ProjectibleWithPredicate contextPredicate be res (Vector n a) where+  project' context be mkE as = traverse (project' context be mkE) as+  projectSkeleton' context be mkM = VS.replicateM (projectSkeleton' context be mkM) -  project' p mkE (a, b, c, d, e, f, g, h) =-    (,,,,,,,) <$> project' p mkE a <*> project' p mkE b <*> project' p mkE c-              <*> project' p mkE d <*> project' p mkE e <*> project' p mkE f-              <*> project' p mkE g <*> project' p mkE h+instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b) where -instance Beamable t => ProjectibleWithPredicate AnyType T.Text (t (QField s)) where-  project' _ mutateM a =+  project' context be mkE (a, b) =+    (,) <$> project' context be mkE a <*> project' context be mkE b+  projectSkeleton' context be mkM =+    (,) <$> projectSkeleton' context be mkM+        <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c) where++  project' context be mkE (a, b, c) =+    (,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+  projectSkeleton' context be mkM =+    (,,) <$> projectSkeleton' context be mkM+         <*> projectSkeleton' context be mkM+         <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c+         , ProjectibleWithPredicate contextPredicate be res d ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c, d) where++  project' context be mkE (a, b, c, d) =+    (,,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+          <*> project' context be mkE d+  projectSkeleton' context be mkM =+    (,,,) <$> projectSkeleton' context be mkM+          <*> projectSkeleton' context be mkM+          <*> projectSkeleton' context be mkM+          <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c+         , ProjectibleWithPredicate contextPredicate be res d, ProjectibleWithPredicate contextPredicate be res e ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c, d, e) where++  project' context be mkE (a, b, c, d, e) =+    (,,,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+           <*> project' context be mkE d <*> project' context be mkE e+  projectSkeleton' context be mkM =+    (,,,,) <$> projectSkeleton' context be mkM+           <*> projectSkeleton' context be mkM+           <*> projectSkeleton' context be mkM+           <*> projectSkeleton' context be mkM+           <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c+         , ProjectibleWithPredicate contextPredicate be res d, ProjectibleWithPredicate contextPredicate be res e, ProjectibleWithPredicate contextPredicate be res f ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c, d, e, f) where++  project' context be  mkE (a, b, c, d, e, f) =+    (,,,,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+            <*> project' context be mkE d <*> project' context be mkE e <*> project' context be mkE f+  projectSkeleton' context be mkM =+    (,,,,,) <$> projectSkeleton' context be mkM+            <*> projectSkeleton' context be mkM+            <*> projectSkeleton' context be mkM+            <*> projectSkeleton' context be mkM+            <*> projectSkeleton' context be mkM+            <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c+         , ProjectibleWithPredicate contextPredicate be res d, ProjectibleWithPredicate contextPredicate be res e, ProjectibleWithPredicate contextPredicate be res f+         , ProjectibleWithPredicate contextPredicate be res g ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c, d, e, f, g) where++  project' context be mkE (a, b, c, d, e, f, g) =+    (,,,,,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+             <*> project' context be mkE d <*> project' context be mkE e <*> project' context be mkE f+             <*> project' context be mkE g+  projectSkeleton' context be mkM =+    (,,,,,,) <$> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM+             <*> projectSkeleton' context be mkM++instance ( ProjectibleWithPredicate contextPredicate be res a, ProjectibleWithPredicate contextPredicate be res b, ProjectibleWithPredicate contextPredicate be res c+         , ProjectibleWithPredicate contextPredicate be res d, ProjectibleWithPredicate contextPredicate be res e, ProjectibleWithPredicate contextPredicate be res f+         , ProjectibleWithPredicate contextPredicate be res g, ProjectibleWithPredicate contextPredicate be res h ) =>+  ProjectibleWithPredicate contextPredicate be res (a, b, c, d, e, f, g, h) where++  project' context be mkE (a, b, c, d, e, f, g, h) =+    (,,,,,,,) <$> project' context be mkE a <*> project' context be mkE b <*> project' context be mkE c+              <*> project' context be mkE d <*> project' context be mkE e <*> project' context be mkE f+              <*> project' context be mkE g <*> project' context be mkE h+  projectSkeleton' context be mkM =+    (,,,,,,,) <$> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM+              <*> projectSkeleton' context be mkM++-- TODO add projectSkeleton'+instance Beamable t => ProjectibleWithPredicate AnyType () T.Text (t (QField s)) where+  project' _ be mutateM a =     zipBeamFieldsM (\(Columnar' f) _ ->-                      Columnar' <$> project' (Proxy @AnyType) mutateM f) a a-instance Beamable t => ProjectibleWithPredicate AnyType T.Text (t (Nullable (QField s))) where-  project' _ mutateM a =+                      Columnar' <$> project' (Proxy @AnyType) be mutateM f) a a++  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . QField False "" <$> (mkM (Proxy @()) (Proxy @())))+                   (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t)++instance Beamable t => ProjectibleWithPredicate AnyType () T.Text (t (Nullable (QField s))) where+  project' _ be mutateM a =     zipBeamFieldsM (\(Columnar' f) _ ->-                      Columnar' <$> project' (Proxy @AnyType) mutateM f) a a-instance ProjectibleWithPredicate AnyType T.Text (QField s a) where-  project' _ mutateM (QField q tbl f) =-    fmap (\f' -> QField q tbl (f' ""))-         (mutateM (Proxy @(QField s a)) (\_ -> f)) -- This is kind of a hack+                      Columnar' <$> project' (Proxy @AnyType) be mutateM f) a a -project :: Projectible syntax a => a -> WithExprContext [ syntax ]-project = sequenceA . DList.toList . execWriter . project' (Proxy @AnyType) (\_ e -> tell (DList.singleton e) >> pure e)+  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . QField False "" <$> mkM (Proxy @()) (Proxy @()))+                   (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t) -reproject :: (IsSql92ExpressionSyntax syntax, Projectible syntax a) =>-             (Int -> syntax) -> a -> a-reproject mkField a =-  evalState (project' (Proxy @AnyType) (\_ _ -> state (\i -> (i, i + 1)) >>= pure . pure . mkField) a) 0+instance Beamable t => ProjectibleWithPredicate AnyType () T.Text (t (Const T.Text)) where+  project' _ be mutateM a =+    zipBeamFieldsM (\(Columnar' f) _ ->+                      Columnar' <$> project' (Proxy @AnyType) be mutateM f) a a++  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . Const <$> mkM (Proxy @()) (Proxy @()))+                   (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t)++instance Beamable t => ProjectibleWithPredicate AnyType () T.Text (t (Nullable (Const T.Text))) where+  project' _ be mutateM a =+    zipBeamFieldsM (\(Columnar' f) _ ->+                      Columnar' <$> project' (Proxy @AnyType) be mutateM f) a a++  projectSkeleton' _ _ mkM =+    zipBeamFieldsM (\_ _ -> Columnar' . Const <$> mkM (Proxy @()) (Proxy @()))+                   (tblSkeleton :: TableSkeleton t) (tblSkeleton :: TableSkeleton t)++instance ProjectibleWithPredicate AnyType () T.Text (Const T.Text a) where+  project' _ _ mutateM (Const a) = Const <$> mutateM (Proxy @()) (Proxy @()) a++  projectSkeleton' _ _ mkM =+    Const <$> mkM (Proxy @()) (Proxy @())++instance ProjectibleWithPredicate AnyType () T.Text (QField s a) where+  project' _ _ mutateM (QField q tbl f) =+    fmap (QField q tbl)+         (mutateM (Proxy @(QField s a)) (Proxy @()) f)++  projectSkeleton' _ _ mkM =+    QField False "" <$> mkM (Proxy @()) (Proxy @())++project :: forall be a+         . Projectible be a => Proxy be -> a -> WithExprContext [ BeamSqlBackendExpressionSyntax be ]+project _ = fmap (fmap fromBeamSqlBackendExpressionSyntax) . sequenceA . DList.toList . execWriter .+            project' (Proxy @AnyType) (Proxy @(be, WithExprContext (BeamSqlBackendExpressionSyntax' be))) (\_ _ e -> tell (DList.singleton e) >> pure e)++reproject :: forall be a+           . (BeamSqlBackend be, Projectible be a)+          => Proxy be -> (Int -> BeamSqlBackendExpressionSyntax be) -> a -> a+reproject _ mkField a =+  evalState (project' (Proxy @AnyType) (Proxy @(be, WithExprContext (BeamSqlBackendExpressionSyntax' be))) (\_ _ _ -> state (\i -> (i, i + 1)) >>= pure . pure . BeamSqlBackendExpressionSyntax' . mkField) a) 0++-- | suitable as argument to 'QAll' in the case of a table result+tableFieldsToExpressions :: ( BeamSqlBackend be, Beamable table )+                         => TableSettings table -> T.Text -> table (QGenExpr ctxt be s)+tableFieldsToExpressions tblSettings newTblNm =+    changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (\_ -> fieldE (qualifiedField newTblNm (_fieldName f))))) tblSettings++mkFieldsSkeleton :: forall be res m+                  . (Projectible be res, MonadState Int m)+                 => (Int -> m (WithExprContext (BeamSqlBackendExpressionSyntax' be))) -> m res+mkFieldsSkeleton go =+    projectSkeleton' (Proxy @AnyType) (Proxy @(be, WithExprContext (BeamSqlBackendExpressionSyntax' be))) $ \_ _ ->+    do i <- get+       put (i + 1)+       go i++mkFieldNames :: forall be res+              . ( BeamSqlBackend be, Projectible be res )+             => (T.Text -> BeamSqlBackendFieldNameSyntax be) -> (res, [ T.Text ])+mkFieldNames mkField =+    runWriter . flip evalStateT 0 $+    mkFieldsSkeleton @be @res $ \i -> do+      let fieldName' = fromString ("res" ++ show i)+      tell [ fieldName' ]+      pure (\_ -> BeamSqlBackendExpressionSyntax' (fieldE (mkField fieldName')))++tableNameFromEntity :: IsSql92TableNameSyntax name+                    => DatabaseEntityDescriptor be (TableEntity tbl)+                    -> name++tableNameFromEntity = tableName <$> dbTableSchema <*> dbTableCurrentName

@@ -27,83 +27,82 @@ data SqlBool  -- | SQL @AND@ operator-(&&.) :: IsSql92ExpressionSyntax syntax-      => QGenExpr context syntax s Bool-      -> QGenExpr context syntax s Bool-      -> QGenExpr context syntax s Bool+(&&.) :: BeamSqlBackend be+      => QGenExpr context be s Bool+      -> QGenExpr context be s Bool+      -> QGenExpr context be s Bool (&&.) = qBinOpE andE  -- | SQL @OR@ operator-(||.) :: IsSql92ExpressionSyntax syntax-      => QGenExpr context syntax s Bool-      -> QGenExpr context syntax s Bool-      -> QGenExpr context syntax s Bool+(||.) :: BeamSqlBackend be+      => QGenExpr context be s Bool+      -> QGenExpr context be s Bool+      -> QGenExpr context be+      s Bool (||.) = qBinOpE orE  -- | SQL @AND@ operator for 'SqlBool'-(&&?.) :: IsSql92ExpressionSyntax syntax-       => QGenExpr context syntax s SqlBool-       -> QGenExpr context syntax s SqlBool-       -> QGenExpr context syntax s SqlBool+(&&?.) :: BeamSqlBackend be+       => QGenExpr context be s SqlBool+       -> QGenExpr context be s SqlBool+       -> QGenExpr context be s SqlBool (&&?.) = qBinOpE andE  -- | SQL @OR@ operator-(||?.) :: IsSql92ExpressionSyntax syntax-       => QGenExpr context syntax s SqlBool-       -> QGenExpr context syntax s SqlBool-       -> QGenExpr context syntax s SqlBool+(||?.) :: BeamSqlBackend be+       => QGenExpr context be s SqlBool+       -> QGenExpr context be s SqlBool+       -> QGenExpr context be s SqlBool (||?.) = qBinOpE orE  infixr 3 &&., &&?. infixr 2 ||., ||?.  -- | SQL @LIKE@ operator-like_ ::-  ( IsSqlExpressionSyntaxStringType syntax text-  , IsSql92ExpressionSyntax syntax ) =>-  QExpr syntax s text -> QExpr syntax s text -> QExpr syntax s Bool+like_ :: ( BeamSqlBackendIsString be text+         , BeamSqlBackend be )+      => QGenExpr ctxt be s text -> QGenExpr ctxt be s text -> QGenExpr ctxt be s Bool like_ (QExpr scrutinee) (QExpr search) =   QExpr (liftA2 likeE scrutinee search)  -- | SQL99 @SIMILAR TO@ operator-similarTo_ ::-  ( IsSqlExpressionSyntaxStringType syntax text-  , IsSql99ExpressionSyntax syntax ) =>-  QExpr syntax s text -> QExpr syntax s text -> QExpr syntax s text+similarTo_ :: ( BeamSqlBackendIsString be text+              , BeamSql99ExpressionBackend be )+           => QGenExpr ctxt be s text -> QGenExpr ctxt be s text -> QGenExpr ctxt be s text similarTo_ (QExpr scrutinee) (QExpr search) =   QExpr (liftA2 similarToE scrutinee search)  infix 4 `like_`, `similarTo_`  -- | SQL @NOT@ operator-not_ :: forall syntax context s.-        IsSql92ExpressionSyntax syntax-     => QGenExpr context syntax s Bool-     -> QGenExpr context syntax s Bool+not_ :: forall be context s+      . BeamSqlBackend be+     => QGenExpr context be s Bool+     -> QGenExpr context be s Bool not_ (QExpr a) = QExpr (fmap notE a)  -- | SQL @NOT@ operator, but operating on 'SqlBool' instead-sqlNot_ :: forall syntax context s.-           IsSql92ExpressionSyntax syntax-        => QGenExpr context syntax s SqlBool-        -> QGenExpr context syntax s SqlBool+sqlNot_ :: forall be context s+         . BeamSqlBackend be+        => QGenExpr context be s SqlBool+        -> QGenExpr context be s SqlBool sqlNot_ (QExpr a) = QExpr (fmap notE a)  -- | SQL @/@ operator-div_ :: (Integral a, IsSql92ExpressionSyntax syntax)-     => QGenExpr context syntax s a -> QGenExpr context syntax s a-     -> QGenExpr context syntax s a+div_ :: (Integral a, BeamSqlBackend be)+     => QGenExpr context be s a -> QGenExpr context be s a+     -> QGenExpr context be s a div_ = qBinOpE divE  infixl 7 `div_`, `mod_`  -- | SQL @%@ operator-mod_ :: (Integral a, IsSql92ExpressionSyntax syntax)-     => QGenExpr context syntax s a -> QGenExpr context syntax s a-     -> QGenExpr context syntax s a+mod_ :: (Integral a, BeamSqlBackend be)+     => QGenExpr context be s a -> QGenExpr context be s a+     -> QGenExpr context be s a mod_ = qBinOpE modE  -- | SQL @CONCAT@ function-concat_ :: IsSql99ConcatExpressionSyntax syntax-        => [ QGenExpr context syntax s T.Text ] -> QGenExpr context syntax s T.Text+concat_ :: BeamSql99ConcatExpressionBackend be+        => [ QGenExpr context be s T.Text ] -> QGenExpr context be s T.Text concat_ es = QExpr (concatE <$> mapM (\(QExpr e) -> e) es)

@@ -32,6 +32,7 @@   , isUnknown_, isNotUnknown_   , unknownAs_, sqlBool_   , possiblyNullBool_+  , fromPossiblyNullBool_    , anyOf_, anyIn_   , allOf_, allIn_@@ -46,8 +47,8 @@  import Database.Beam.Schema.Tables import Database.Beam.Backend.SQL-import Database.Beam.Backend.SQL.AST (Expression)-import Database.Beam.Backend.SQL.Builder (SqlSyntaxBuilder)+-- import Database.Beam.Backend.SQL.AST (Expression)+--import Database.Beam.Backend.SQL.Builder (SqlSyntaxBackend)  import Control.Applicative import Control.Monad.State@@ -64,47 +65,47 @@ import GHC.TypeLits  -- | A data structure representing the set to quantify a comparison operator over.-data QQuantified expr s r-  = QQuantified (Sql92ExpressionQuantifierSyntax expr) (WithExprContext expr)+data QQuantified be s r+  = QQuantified (BeamSqlBackendExpressionQuantifierSyntax be) (WithExprContext (BeamSqlBackendExpressionSyntax be))  -- | Convert a /known not null/ bool to a 'SqlBool'. See 'unknownAs_' for the inverse sqlBool_ :: QGenExpr context syntax s Bool -> QGenExpr context syntax s SqlBool sqlBool_ (QExpr s) = QExpr s  -- | SQL @IS TRUE@ operator-isTrue_ :: IsSql92ExpressionSyntax syntax-        => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isTrue_ :: BeamSqlBackend be+        => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isTrue_ (QExpr s) = QExpr (fmap isTrueE s)  -- | SQL @IS NOT TRUE@ operator-isNotTrue_ :: IsSql92ExpressionSyntax syntax-           => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isNotTrue_ :: BeamSqlBackend be+           => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isNotTrue_ (QExpr s) = QExpr (fmap isNotTrueE s)  -- | SQL @IS FALSE@ operator-isFalse_ :: IsSql92ExpressionSyntax syntax-         => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isFalse_ :: BeamSqlBackend be+         => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isFalse_ (QExpr s) = QExpr (fmap isFalseE s)  -- | SQL @IS NOT FALSE@ operator-isNotFalse_ :: IsSql92ExpressionSyntax syntax-            => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isNotFalse_ :: BeamSqlBackend be+            => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isNotFalse_ (QExpr s) = QExpr (fmap isNotFalseE s)  -- | SQL @IS UNKNOWN@ operator-isUnknown_ :: IsSql92ExpressionSyntax syntax-           => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isUnknown_ :: BeamSqlBackend be+           => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isUnknown_ (QExpr s) = QExpr (fmap isUnknownE s)  -- | SQL @IS NOT UNKNOWN@ operator-isNotUnknown_ :: IsSql92ExpressionSyntax syntax-              => QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+isNotUnknown_ :: BeamSqlBackend be+              => QGenExpr context be s SqlBool -> QGenExpr context be s Bool isNotUnknown_ (QExpr s) = QExpr (fmap isNotUnknownE s)  -- | Return the first argument if the expression has the unknown SQL value -- See 'sqlBool_' for the inverse-unknownAs_ :: IsSql92ExpressionSyntax syntax-           => Bool -> QGenExpr context syntax s SqlBool -> QGenExpr context syntax s Bool+unknownAs_ :: BeamSqlBackend be+           => Bool -> QGenExpr context be s SqlBool -> QGenExpr context be s Bool unknownAs_ False = isTrue_ -- If unknown is being treated as false, then return true only if the expression is true unknownAs_ True  = isNotFalse_ -- If unknown is being treated as true, then return true only if the expression is not false @@ -112,21 +113,22 @@ -- is useful if you want to get the value of a SQL boolean expression -- directly, without having to specify what to do on @UNKNOWN@. Note -- that both @NULL@ and @UNKNOWN@ will be returned as 'Nothing'.-possiblyNullBool_ :: QGenExpr context syntax s SqlBool -> QGenExpr context syntax s (Maybe Bool)+possiblyNullBool_ :: QGenExpr context be s SqlBool -> QGenExpr context be s (Maybe Bool) possiblyNullBool_ (QExpr e) = QExpr e +-- | Convert a possibly @NULL@ 'Bool' to a 'SqlBool'.+fromPossiblyNullBool_ :: QGenExpr context be s (Maybe Bool) -> QGenExpr context be s SqlBool+fromPossiblyNullBool_ (QExpr e) = QExpr e+ -- | A 'QQuantified' representing a SQL @ALL(..)@ for use with a --   <#quantified-comparison-operator quantified comparison operator> -- --   Accepts a subquery. Use 'allIn_' for an explicit list allOf_-  :: forall s a select expr db.-   ( IsSql92SelectSyntax select-   , IsSql92ExpressionSyntax expr-   , HasQBuilder select-   , Sql92ExpressionSelectSyntax expr ~ select )-  => Q select db (QNested s) (QExpr (Sql92SelectExpressionSyntax select) (QNested s) a)-  -> QQuantified expr s a+  :: forall s a be db+   . ( BeamSqlBackend be, HasQBuilder be )+  => Q be db (QNested s) (QExpr be (QNested s) a)+  -> QQuantified be s a allOf_ s = QQuantified quantifyOverAll (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))  -- | A 'QQuantified' representing a SQL @ALL(..)@ for use with a@@ -135,10 +137,10 @@ --   Accepts an explicit list of typed expressions. Use 'allOf_' for --   a subquery allIn_-  :: forall s a expr-   . ( IsSql92ExpressionSyntax expr )-  => [QExpr expr s a]-  -> QQuantified expr s a+  :: forall s a be+   . BeamSqlBackend be+  => [QExpr be s a]+  -> QQuantified be s a allIn_ es = QQuantified quantifyOverAll (quantifierListE <$> mapM (\(QExpr e) -> e) es)  -- | A 'QQuantified' representing a SQL @ANY(..)@ for use with a@@ -146,13 +148,10 @@ -- --   Accepts a subquery. Use 'anyIn_' for an explicit list anyOf_-  :: forall s a select expr db.-   ( IsSql92SelectSyntax select-   , IsSql92ExpressionSyntax expr-   , HasQBuilder select-   , Sql92ExpressionSelectSyntax expr ~ select )-  => Q select db (QNested s) (QExpr (Sql92SelectExpressionSyntax select) (QNested s) a)-  -> QQuantified expr s a+  :: forall s a be db+   . ( BeamSqlBackend be, HasQBuilder be )+  => Q be db (QNested s) (QExpr be (QNested s) a)+  -> QQuantified be s a anyOf_ s = QQuantified quantifyOverAny (\tblPfx -> subqueryE (buildSqlQuery tblPfx s))  -- | A 'QQuantified' representing a SQL @ANY(..)@ for use with a@@ -161,25 +160,24 @@ --   Accepts an explicit list of typed expressions. Use 'anyOf_' for --   a subquery anyIn_-  :: forall s a expr-   . ( IsSql92ExpressionSyntax expr )-  => [QExpr expr s a]-  -> QQuantified expr s a+  :: forall s a be+   . BeamSqlBackend be+  => [QExpr be s a]+  -> QQuantified be s a anyIn_ es = QQuantified quantifyOverAny (quantifierListE <$> mapM (\(QExpr e) -> e) es)  -- | SQL @BETWEEN@ clause-between_ :: IsSql92ExpressionSyntax syntax-         => QGenExpr context syntax s a -> QGenExpr context syntax s a-         -> QGenExpr context syntax s a -> QGenExpr context syntax s Bool+between_ :: BeamSqlBackend be+         => QGenExpr context be s a -> QGenExpr context be s a+         -> QGenExpr context be s a -> QGenExpr context be s Bool between_ (QExpr a) (QExpr min_) (QExpr max_) =   QExpr (liftA3 betweenE a min_ max_)  -- | SQL @IN@ predicate-in_ :: ( IsSql92ExpressionSyntax syntax-       , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool )-    => QGenExpr context syntax s a-    -> [ QGenExpr context syntax s a ]-    -> QGenExpr context syntax s Bool+in_ :: BeamSqlBackend be+    => QGenExpr context be s a+    -> [ QGenExpr context be s a ]+    -> QGenExpr context be s Bool in_ _ [] = QExpr (pure (valueE (sqlValueSyntax False))) in_ (QExpr row) options = QExpr (inE <$> row <*> mapM (\(QExpr o) -> o) options) @@ -213,18 +211,23 @@ infix 4 <., >., <=., >=. infix 4 <*., >*., <=*., >=*. --- | Class for Haskell types that can be compared for equality in the given expression syntax-class (IsSql92ExpressionSyntax syntax, HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool) =>-  HasSqlEqualityCheck syntax a where+-- | Class for Haskell types that can be compared for equality in the given backend+class BeamSqlBackend be => HasSqlEqualityCheck be a where -  sqlEqE, sqlNeqE :: Proxy a -> syntax -> syntax -> syntax-  sqlEqE _ = eqE Nothing-  sqlNeqE _ = neqE Nothing+  sqlEqE, sqlNeqE :: Proxy a -> Proxy be+                  -> BeamSqlBackendExpressionSyntax be+                  -> BeamSqlBackendExpressionSyntax be+                  -> BeamSqlBackendExpressionSyntax be+  sqlEqE _ _ = eqE Nothing+  sqlNeqE _ _ = neqE Nothing    -- | Tri-state equality-  sqlEqTriE, sqlNeqTriE :: Proxy a -> syntax -> syntax -> syntax-  sqlEqTriE _ = eqE Nothing-  sqlNeqTriE _ = neqE Nothing+  sqlEqTriE, sqlNeqTriE :: Proxy a -> Proxy be+                        -> BeamSqlBackendExpressionSyntax be+                        -> BeamSqlBackendExpressionSyntax be+                        -> BeamSqlBackendExpressionSyntax be+  sqlEqTriE _ _ = eqE Nothing+  sqlNeqTriE _ _ = neqE Nothing  type family CanCheckMaybeEquality a :: Constraint where   CanCheckMaybeEquality (Maybe a) =@@ -232,23 +235,26 @@                'Text "Beam can only reasonably check equality of a single nesting of Maybe.")   CanCheckMaybeEquality a = () -instance (HasSqlEqualityCheck syntax a, CanCheckMaybeEquality a) => HasSqlEqualityCheck syntax (Maybe a) where-  sqlEqE _ a b = eqMaybeE a b (sqlEqE (Proxy @a) a b)-  sqlNeqE _ a b = neqMaybeE a b (sqlNeqE (Proxy @a) a b)+instance (HasSqlEqualityCheck be a, CanCheckMaybeEquality a) => HasSqlEqualityCheck be (Maybe a) where+  sqlEqE _ _ a b = eqMaybeE a b (sqlEqE (Proxy @a) (Proxy @be) a b)+  sqlNeqE _ _ a b = neqMaybeE a b (sqlNeqE (Proxy @a) (Proxy @be) a b) -instance HasSqlEqualityCheck syntax a => HasSqlEqualityCheck syntax (SqlSerial a) where+instance HasSqlEqualityCheck be a => HasSqlEqualityCheck be (SqlSerial a) where   sqlEqE _ = sqlEqE (Proxy @a)   sqlNeqE _ = sqlNeqE (Proxy @a)    sqlEqTriE _ = sqlEqTriE (Proxy @a)   sqlNeqTriE _ = sqlNeqTriE (Proxy @a) --- | Class for Haskell types that can be compared for quantified equality in the given expression syntax-class HasSqlEqualityCheck syntax a => HasSqlQuantifiedEqualityCheck syntax a where-  sqlQEqE, sqlQNeqE :: Proxy a -> Maybe (Sql92ExpressionQuantifierSyntax syntax)-                    -> syntax -> syntax -> syntax-  sqlQEqE _ = eqE-  sqlQNeqE _ = neqE+-- | Class for Haskell types that can be compared for quantified equality in the given backend+class HasSqlEqualityCheck be a => HasSqlQuantifiedEqualityCheck be a where+  sqlQEqE, sqlQNeqE :: Proxy a -> Proxy be+                    -> Maybe (BeamSqlBackendExpressionQuantifierSyntax be)+                    -> BeamSqlBackendExpressionSyntax be+                    -> BeamSqlBackendExpressionSyntax be+                    -> BeamSqlBackendExpressionSyntax be+  sqlQEqE _ _ = eqE+  sqlQNeqE _ _ = neqE  instance (HasSqlQuantifiedEqualityCheck syntax a, CanCheckMaybeEquality a) => HasSqlQuantifiedEqualityCheck syntax (Maybe a) where   sqlQEqE _ = sqlQEqE (Proxy @a)@@ -259,33 +265,32 @@   sqlQNeqE _ = sqlQNeqE (Proxy @a)  -- | Compare two arbitrary expressions (of the same type) for equality-instance ( IsSql92ExpressionSyntax syntax, HasSqlEqualityCheck syntax a ) =>-  SqlEq (QGenExpr context syntax s) (QGenExpr context syntax s a) where+instance ( BeamSqlBackend be, HasSqlEqualityCheck be a ) =>+  SqlEq (QGenExpr context be s) (QGenExpr context be s a) where -  (==.) = qBinOpE (sqlEqE (Proxy @a))-  (/=.) = qBinOpE (sqlNeqE (Proxy @a))+  (==.) = qBinOpE (sqlEqE (Proxy @a) (Proxy @be))+  (/=.) = qBinOpE (sqlNeqE (Proxy @a) (Proxy @be)) -  (==?.) = qBinOpE (sqlEqTriE (Proxy @a))-  (/=?.) = qBinOpE (sqlNeqTriE (Proxy @a))+  (==?.) = qBinOpE (sqlEqTriE (Proxy @a) (Proxy @be))+  (/=?.) = qBinOpE (sqlNeqTriE (Proxy @a) (Proxy @be))  -- | Two arbitrary expressions can be quantifiably compared for equality.-instance ( IsSql92ExpressionSyntax syntax, HasSqlQuantifiedEqualityCheck syntax a ) =>-  SqlEqQuantified (QGenExpr context syntax s) (QQuantified syntax s a) (QGenExpr context syntax s a) where+instance ( BeamSqlBackend be, HasSqlQuantifiedEqualityCheck be a ) =>+  SqlEqQuantified (QGenExpr context be s) (QQuantified be s a) (QGenExpr context be s a) where -  a ==*. QQuantified q b = qBinOpE (sqlQEqE (Proxy @a) (Just q)) a (QExpr b)-  a /=*. QQuantified q b = qBinOpE (sqlQNeqE (Proxy @a) (Just q)) a (QExpr b)+  a ==*. QQuantified q b = qBinOpE (sqlQEqE (Proxy @a) (Proxy @be) (Just q)) a (QExpr b)+  a /=*. QQuantified q b = qBinOpE (sqlQNeqE (Proxy @a) (Proxy @be) (Just q)) a (QExpr b)  -- | Constraint synonym to check if two tables can be compared for equality-type HasTableEquality expr tbl =-  (FieldsFulfillConstraint (HasSqlEqualityCheck expr) tbl, Beamable tbl)-type HasTableEqualityNullable expr tbl =-  (FieldsFulfillConstraintNullable (HasSqlEqualityCheck expr) tbl, Beamable tbl)+type HasTableEquality be tbl =+  (FieldsFulfillConstraint (HasSqlEqualityCheck be) tbl, Beamable tbl)+type HasTableEqualityNullable be tbl =+  (FieldsFulfillConstraintNullable (HasSqlEqualityCheck be) tbl, Beamable tbl)  -- | Compare two arbitrary 'Beamable' types containing 'QGenExpr's for equality.-instance ( IsSql92ExpressionSyntax syntax, FieldsFulfillConstraint (HasSqlEqualityCheck syntax) tbl-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool-         , Beamable tbl ) =>-         SqlEq (QGenExpr context syntax s) (tbl (QGenExpr context syntax s)) where+instance ( BeamSqlBackend be, Beamable tbl+         , FieldsFulfillConstraint (HasSqlEqualityCheck be) tbl ) =>+         SqlEq (QGenExpr context be s) (tbl (QGenExpr context be s)) where    a ==. b = let (_, e) = runState (zipBeamFieldsM                                    (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) ->@@ -293,7 +298,7 @@                                                     case expr of                                                       Nothing -> Just $ x ==. y                                                       Just expr' -> Just $ expr' &&. x ==. y)-                                          return x') (withConstraints @(HasSqlEqualityCheck syntax) `alongsideTable` a) b) Nothing+                                          return x') (withConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing             in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e   a /=. b = not_ (a ==. b) @@ -303,15 +308,13 @@                                                      case expr of                                                        Nothing -> Just $ x ==?. y                                                        Just expr' -> Just $ expr' &&?. x ==?. y)-                                           return x') (withConstraints @(HasSqlEqualityCheck syntax) `alongsideTable` a) b) Nothing+                                           return x') (withConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing             in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e   a /=?. b = sqlNot_ (a ==?. b) -instance ( IsSql92ExpressionSyntax syntax-         , FieldsFulfillConstraintNullable (HasSqlEqualityCheck syntax) tbl-         , HasSqlValueSyntax (Sql92ExpressionValueSyntax syntax) Bool-         , Beamable tbl)-    => SqlEq (QGenExpr context syntax s) (tbl (Nullable (QGenExpr context syntax s))) where+instance ( BeamSqlBackend be, Beamable tbl+         , FieldsFulfillConstraintNullable (HasSqlEqualityCheck be) tbl )+    => SqlEq (QGenExpr context be s) (tbl (Nullable (QGenExpr context be s))) where    a ==. b = let (_, e) = runState (zipBeamFieldsM                                       (\x'@(Columnar' (Columnar' (WithConstraint _) :*: Columnar' x)) (Columnar' y) -> do@@ -320,7 +323,7 @@                                                       Nothing -> Just $ x ==. y                                                       Just expr' -> Just $ expr' &&. x ==. y)                                           return x')-                                      (withNullableConstraints @(HasSqlEqualityCheck syntax) `alongsideTable` a) b) Nothing+                                      (withNullableConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing             in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e   a /=. b = not_ (a ==. b) @@ -330,7 +333,7 @@                                                      case expr of                                                        Nothing -> Just $ x ==?. y                                                        Just expr' -> Just $ expr' &&?. x ==?. y)-                                           return x') (withNullableConstraints @(HasSqlEqualityCheck syntax) `alongsideTable` a) b) Nothing+                                           return x') (withNullableConstraints @(HasSqlEqualityCheck be) `alongsideTable` a) b) Nothing             in fromMaybe (QExpr (\_ -> valueE (sqlValueSyntax True))) e   a /=?. b = sqlNot_ (a ==?. b) @@ -353,105 +356,64 @@    (<*.), (>*.), (<=*.), (>=*.) :: e -> quantified  -> expr Bool -instance IsSql92ExpressionSyntax syntax =>-  SqlOrd (QGenExpr context syntax s) (QGenExpr context syntax s a) where+instance BeamSqlBackend be =>+  SqlOrd (QGenExpr context be s) (QGenExpr context be s a) where    (<.) = qBinOpE (ltE Nothing)   (>.) = qBinOpE (gtE Nothing)   (<=.) = qBinOpE (leE Nothing)   (>=.) = qBinOpE (geE Nothing) -instance IsSql92ExpressionSyntax syntax =>-  SqlOrdQuantified (QGenExpr context syntax s) (QQuantified syntax s a) (QGenExpr context syntax s a) where+instance BeamSqlBackend be =>+  SqlOrdQuantified (QGenExpr context be s) (QQuantified be s a) (QGenExpr context be s a) where   a <*. QQuantified q b = qBinOpE (ltE (Just q)) a (QExpr b)   a <=*. QQuantified q b = qBinOpE (leE (Just q)) a (QExpr b)   a >*. QQuantified q b = qBinOpE (gtE (Just q)) a (QExpr b)   a >=*. QQuantified q b = qBinOpE (geE (Just q)) a (QExpr b) -instance HasSqlEqualityCheck Expression Text-instance HasSqlEqualityCheck Expression Integer-instance HasSqlEqualityCheck Expression Int-instance HasSqlEqualityCheck Expression Int8-instance HasSqlEqualityCheck Expression Int16-instance HasSqlEqualityCheck Expression Int32-instance HasSqlEqualityCheck Expression Int64-instance HasSqlEqualityCheck Expression Word-instance HasSqlEqualityCheck Expression Word8-instance HasSqlEqualityCheck Expression Word16-instance HasSqlEqualityCheck Expression Word32-instance HasSqlEqualityCheck Expression Word64-instance HasSqlEqualityCheck Expression Double-instance HasSqlEqualityCheck Expression Float-instance HasSqlEqualityCheck Expression Bool-instance HasSqlEqualityCheck Expression UTCTime-instance HasSqlEqualityCheck Expression LocalTime-instance HasSqlEqualityCheck Expression Day-instance HasSqlEqualityCheck Expression TimeOfDay-instance HasSqlEqualityCheck Expression a =>-  HasSqlEqualityCheck Expression (Tagged t a)--instance HasSqlQuantifiedEqualityCheck Expression Text-instance HasSqlQuantifiedEqualityCheck Expression Integer-instance HasSqlQuantifiedEqualityCheck Expression Int-instance HasSqlQuantifiedEqualityCheck Expression Int8-instance HasSqlQuantifiedEqualityCheck Expression Int16-instance HasSqlQuantifiedEqualityCheck Expression Int32-instance HasSqlQuantifiedEqualityCheck Expression Int64-instance HasSqlQuantifiedEqualityCheck Expression Word-instance HasSqlQuantifiedEqualityCheck Expression Word8-instance HasSqlQuantifiedEqualityCheck Expression Word16-instance HasSqlQuantifiedEqualityCheck Expression Word32-instance HasSqlQuantifiedEqualityCheck Expression Word64-instance HasSqlQuantifiedEqualityCheck Expression Double-instance HasSqlQuantifiedEqualityCheck Expression Float-instance HasSqlQuantifiedEqualityCheck Expression Bool-instance HasSqlQuantifiedEqualityCheck Expression UTCTime-instance HasSqlQuantifiedEqualityCheck Expression LocalTime-instance HasSqlQuantifiedEqualityCheck Expression Day-instance HasSqlQuantifiedEqualityCheck Expression TimeOfDay-instance HasSqlQuantifiedEqualityCheck Expression a =>-  HasSqlQuantifiedEqualityCheck Expression (Tagged t a)+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Text+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Integer+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int8+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int16+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int32+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Int64+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word8+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word16+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word32+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Word64+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Double+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Float+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Bool+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) UTCTime+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) LocalTime+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) Day+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlEqualityCheck (MockSqlBackend cmd) TimeOfDay+instance ( BeamSqlBackend (MockSqlBackend cmd)+         , HasSqlEqualityCheck (MockSqlBackend cmd) a+         ) => HasSqlEqualityCheck (MockSqlBackend cmd) (Tagged t a) -instance HasSqlEqualityCheck SqlSyntaxBuilder Text-instance HasSqlEqualityCheck SqlSyntaxBuilder Integer-instance HasSqlEqualityCheck SqlSyntaxBuilder Int-instance HasSqlEqualityCheck SqlSyntaxBuilder Int8-instance HasSqlEqualityCheck SqlSyntaxBuilder Int16-instance HasSqlEqualityCheck SqlSyntaxBuilder Int32-instance HasSqlEqualityCheck SqlSyntaxBuilder Int64-instance HasSqlEqualityCheck SqlSyntaxBuilder Word-instance HasSqlEqualityCheck SqlSyntaxBuilder Word8-instance HasSqlEqualityCheck SqlSyntaxBuilder Word16-instance HasSqlEqualityCheck SqlSyntaxBuilder Word32-instance HasSqlEqualityCheck SqlSyntaxBuilder Word64-instance HasSqlEqualityCheck SqlSyntaxBuilder Double-instance HasSqlEqualityCheck SqlSyntaxBuilder Float-instance HasSqlEqualityCheck SqlSyntaxBuilder Bool-instance HasSqlEqualityCheck SqlSyntaxBuilder UTCTime-instance HasSqlEqualityCheck SqlSyntaxBuilder LocalTime-instance HasSqlEqualityCheck SqlSyntaxBuilder Day-instance HasSqlEqualityCheck SqlSyntaxBuilder TimeOfDay-instance HasSqlEqualityCheck SqlSyntaxBuilder a =>-  HasSqlEqualityCheck SqlSyntaxBuilder (Tagged t a)+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Text+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Integer+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int8+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int16+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int32+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Int64+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word8+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word16+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word32+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Word64+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Double+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Float+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Bool+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) UTCTime+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) LocalTime+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) Day+instance BeamSqlBackend (MockSqlBackend cmd) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) TimeOfDay+instance ( BeamSqlBackend (MockSqlBackend cmd)+         , HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) a+         ) => HasSqlQuantifiedEqualityCheck (MockSqlBackend cmd) (Tagged t a) -instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Text-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Integer-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int8-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int16-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int32-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Int64-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word8-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word16-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word32-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Word64-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Double-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Float-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Bool-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder UTCTime-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder LocalTime-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder Day-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder TimeOfDay-instance HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder a =>-  HasSqlQuantifiedEqualityCheck SqlSyntaxBuilder (Tagged t a)

@@ -29,49 +29,41 @@  -- | Synonym of 'OneToMany'. Useful for giving more meaningful types, when the --   relationship is meant to be one-to-one.-type OneToOne db s one many = OneToMany db s one many+type OneToOne be db s one many = OneToMany be db s one many  -- | Convenience type to declare one-to-many relationships. See the manual --   section on --   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information-type OneToMany db s one many =-  forall syntax.-  ( IsSql92SelectSyntax syntax, HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey one)-  , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool ) =>-  one (QExpr (Sql92SelectExpressionSyntax syntax) s) ->-  Q syntax db s (many (QExpr (Sql92SelectExpressionSyntax syntax) s))+type OneToMany be db s one many =+  ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool ) =>+  one (QExpr be s) -> Q be db s (many (QExpr be s))  -- | Synonym of 'OneToManyOptional'. Useful for giving more meaningful types, --   when the relationship is meant to be one-to-one.-type OneToMaybe db s tbl rel = OneToManyOptional db s tbl rel+type OneToMaybe be db s tbl rel = OneToManyOptional be db s tbl rel  -- | Convenience type to declare one-to-many relationships with a nullable --   foreign key. See the manual section on --   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information-type OneToManyOptional db s tbl rel =-  forall syntax.-  ( IsSql92SelectSyntax syntax, HasTableEqualityNullable (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)-  , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool-  , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) SqlNull ) =>-  tbl (QExpr (Sql92SelectExpressionSyntax syntax) s) ->-  Q syntax db s (rel (Nullable (QExpr (Sql92SelectExpressionSyntax syntax) s)))+type OneToManyOptional be db s tbl rel =+  ( BeamSqlBackend be, BeamSqlBackendCanSerialize be Bool+  , BeamSqlBackendCanSerialize be SqlNull ) =>+  tbl (QExpr be s) -> Q be db s (rel (Nullable (QExpr be s)))  -- | Used to define one-to-many (or one-to-one) relationships. Takes the table --   to fetch, a way to extract the foreign key from that table, and the table to --   relate to. oneToMany_, oneToOne_-  :: ( IsSql92SelectSyntax syntax-     , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool-     , Database be db-     , HasTableEquality (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)+  :: ( Database be db, BeamSqlBackend be+     , HasTableEquality be (PrimaryKey tbl)      , Table tbl, Table rel )   => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch (many) -}-  -> (rel (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey tbl (QExpr (Sql92SelectExpressionSyntax syntax) s))+  -> (rel (QExpr be s) -> PrimaryKey tbl (QExpr be s))      {-^ Foreign key -}-  -> tbl (QExpr (Sql92SelectExpressionSyntax syntax) s)-  -> Q syntax db s (rel (QExpr (Sql92SelectExpressionSyntax syntax) s))+  -> tbl (QExpr be s)+  -> Q be db s (rel (QExpr be s)) oneToMany_ rel getKey tbl =   join_ rel (\rel' -> getKey rel' ==. pk tbl) oneToOne_ = oneToMany_@@ -80,17 +72,14 @@ --   foreign key. Takes the table to fetch, a way to extract the foreign key --   from that table, and the table to relate to. oneToManyOptional_, oneToMaybe_-  :: ( IsSql92SelectSyntax syntax-     , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) Bool-     , HasSqlValueSyntax (Sql92ExpressionValueSyntax (Sql92SelectExpressionSyntax syntax)) SqlNull-     , HasTableEqualityNullable (Sql92SelectExpressionSyntax syntax) (PrimaryKey tbl)-     , Database be db-     , Table tbl, Table rel )+  :: ( BeamSqlBackend be, Database be db+     , Table tbl, Table rel+     , HasTableEqualityNullable be (PrimaryKey tbl) )   => DatabaseEntity be db (TableEntity rel) {-^ Table to fetch -}-  -> (rel (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey tbl (Nullable (QExpr (Sql92SelectExpressionSyntax syntax) s)))+  -> (rel (QExpr be s) -> PrimaryKey tbl (Nullable (QExpr be s)))      {-^ Foreign key -}-  -> tbl (QExpr (Sql92SelectExpressionSyntax syntax) s)-  -> Q syntax db s (rel (Nullable (QExpr (Sql92SelectExpressionSyntax syntax) s)))+  -> tbl (QExpr be s)+  -> Q be db s (rel (Nullable (QExpr be s))) oneToManyOptional_ rel getKey tbl =   leftJoin_ (all_ rel) (\rel' -> getKey rel' ==. just_ (pk tbl)) oneToMaybe_ = oneToManyOptional_@@ -101,29 +90,27 @@ --   section on --   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information-type ManyToMany db left right =-  forall syntax s.-  ( Sql92SelectSanityCheck syntax, IsSql92SelectSyntax syntax+type ManyToMany be db left right =+  forall s.+  ( BeamSqlBackend be -  , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-  , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s)) ) =>-  Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s)) -> Q syntax db s (right (QExpr (Sql92SelectExpressionSyntax syntax) s)) ->-  Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s), right (QExpr (Sql92SelectExpressionSyntax syntax) s))+  , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))+  , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) ) =>+  Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s)) ->+  Q be db s (left (QExpr be s), right (QExpr be s))  -- | Convenience type to declare many-to-many relationships with additional --   data. See the manual section on --   <http://tathougies.github.io/beam/user-guide/queries/relationships/ relationships> --   for more information-type ManyToManyThrough db through left right =-  forall syntax s.-  ( Sql92SelectSanityCheck syntax, IsSql92SelectSyntax syntax+type ManyToManyThrough be db through left right =+  forall s.+  ( BeamSqlBackend be -  , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-  , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s)) ) =>-  Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s)) -> Q syntax db s (right (QExpr (Sql92SelectExpressionSyntax syntax) s)) ->-  Q syntax db s ( through (QExpr (Sql92SelectExpressionSyntax syntax) s)-                , left (QExpr (Sql92SelectExpressionSyntax syntax) s)-                , right (QExpr (Sql92SelectExpressionSyntax syntax) s))+  , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))+  , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) ) =>+  Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s)) ->+  Q be db s ( through (QExpr be s), left (QExpr be s), right (QExpr be s) )  -- | Used to define many-to-many relationships without any additional data. --   Takes the join table and two key extraction functions from that table to the@@ -132,18 +119,17 @@ --   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual> --   for more indformation. manyToMany_-  :: ( Database be db, Table joinThrough-     , Table left, Table right-     , Sql92SelectSanityCheck syntax-     , IsSql92SelectSyntax syntax+  :: ( Database be db+     , Table joinThrough, Table left, Table right+     , BeamSqlBackend be -     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s)) )+     , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))+     , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) )   => DatabaseEntity be db (TableEntity joinThrough)-  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s)) -> Q syntax db s (right (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s), right (QExpr (Sql92SelectExpressionSyntax syntax) s))+  -> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))+  -> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))+  -> Q be db s (left (QExpr be s)) -> Q be db s (right (QExpr be s))+  -> Q be db s (left (QExpr be s), right (QExpr be s)) manyToMany_ joinTbl leftKey rightKey left right = fmap (\(_, l, r) -> (l, r)) $                                                   manyToManyPassthrough_ joinTbl leftKey rightKey left right @@ -154,21 +140,21 @@ --   See <http://tathougies.github.io/beam/user-guide/queries/relationships/ the manual> --   for more indformation. manyToManyPassthrough_-  :: ( Database be db, Table joinThrough-     , Table left, Table right-     , Sql92SelectSanityCheck syntax-     , IsSql92SelectSyntax syntax+  :: ( Database be db+     , Table joinThrough, Table left, Table right -     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-     , SqlEq (QExpr (Sql92SelectExpressionSyntax syntax) s) (PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s)) )+     , BeamSqlBackend be++     , SqlEq (QExpr be s) (PrimaryKey left (QExpr be s))+     , SqlEq (QExpr be s) (PrimaryKey right (QExpr be s)) )   => DatabaseEntity be db (TableEntity joinThrough)-  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey left (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> (joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s) -> PrimaryKey right (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> Q syntax db s (left (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> Q syntax db s (right (QExpr (Sql92SelectExpressionSyntax syntax) s))-  -> Q syntax db s ( joinThrough (QExpr (Sql92SelectExpressionSyntax syntax) s)-                   , left (QExpr (Sql92SelectExpressionSyntax syntax) s)-                  , right (QExpr (Sql92SelectExpressionSyntax syntax) s))+  -> (joinThrough (QExpr be s) -> PrimaryKey left (QExpr be s))+  -> (joinThrough (QExpr be s) -> PrimaryKey right (QExpr be s))+  -> Q be db s (left (QExpr be s))+  -> Q be db s (right (QExpr be s))+  -> Q be db s ( joinThrough (QExpr be s)+               , left (QExpr be s)+               , right (QExpr be s)) manyToManyPassthrough_ joinTbl leftKey rightKey left right =   do left_ <- left      right_ <- right

@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-}  module Database.Beam.Query.SQL92@@ -8,15 +9,16 @@ import           Database.Beam.Query.Internal import           Database.Beam.Backend.SQL -import           Database.Beam.Schema.Tables- import           Control.Monad.Free.Church import           Control.Monad.Free+ #if !MIN_VERSION_base(4, 11, 0)-import           Control.Monad.Writer+import           Control.Monad.Writer hiding ((<>))+import           Data.Semigroup #endif  import           Data.Maybe+import           Data.Proxy (Proxy(Proxy)) import           Data.String import qualified Data.Text as T @@ -30,45 +32,48 @@ andE' (Just x) (Just y) = Just (andE x y)  newtype PreserveLeft a b = PreserveLeft { unPreserveLeft :: (a, b) }-instance ProjectibleWithPredicate c syntax b => ProjectibleWithPredicate c syntax (PreserveLeft a b) where-  project' p f (PreserveLeft (a, b)) =-    PreserveLeft . (a,) <$> project' p f b+instance (Monoid a, ProjectibleWithPredicate c syntax res b) => ProjectibleWithPredicate c syntax res (PreserveLeft a b) where+  project' context be f (PreserveLeft (a, b)) =+    PreserveLeft . (a,) <$> project' context be f b -type SelectStmtFn select-  =  Sql92SelectSelectTableSyntax select- -> [Sql92SelectOrderingSyntax select]+  projectSkeleton' ctxt be mkM =+    PreserveLeft . (mempty,) <$> projectSkeleton' ctxt be mkM++type SelectStmtFn be+  =  BeamSqlBackendSelectTableSyntax be+ -> [BeamSqlBackendOrderingSyntax be]  -> Maybe Integer {-^ LIMIT -}  -> Maybe Integer {-^ OFFSET -}- -> select+ -> BeamSqlBackendSelectSyntax be -data QueryBuilder select+data QueryBuilder be   = QueryBuilder   { qbNextTblRef :: Int-  , qbFrom  :: Maybe (Sql92SelectTableFromSyntax (Sql92SelectSelectTableSyntax select))-  , qbWhere :: Maybe (Sql92SelectExpressionSyntax select) }+  , qbFrom  :: Maybe (BeamSqlBackendFromSyntax be)+  , qbWhere :: Maybe (BeamSqlBackendExpressionSyntax be) } -data SelectBuilder syntax (db :: (* -> *) -> *) a where-  SelectBuilderQ :: ( IsSql92SelectSyntax syntax-                    , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a ) =>-                    a -> QueryBuilder syntax -> SelectBuilder syntax db a+data SelectBuilder be (db :: (* -> *) -> *) a where+  SelectBuilderQ :: ( BeamSqlBackend be+                    , Projectible be a )+                 => a -> QueryBuilder be -> SelectBuilder be db a   SelectBuilderGrouping-      :: ( IsSql92SelectSyntax syntax-         , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax syntax))) a )-      => a -> QueryBuilder syntax-      -> Maybe (Sql92SelectGroupingSyntax syntax)-      -> Maybe (Sql92SelectExpressionSyntax syntax)-      -> Maybe (Sql92SelectTableSetQuantifierSyntax (Sql92SelectSelectTableSyntax syntax))-      -> SelectBuilder syntax db a+      :: ( BeamSqlBackend be+         , Projectible be a )+      => a -> QueryBuilder be+      -> Maybe (BeamSqlBackendGroupingSyntax be)+      -> Maybe (BeamSqlBackendExpressionSyntax be)+      -> Maybe (BeamSqlBackendSetQuantifierSyntax be)+      -> SelectBuilder be db a   SelectBuilderSelectSyntax :: Bool {- Whether or not this contains UNION, INTERSECT, EXCEPT, etc -}-                            -> a -> Sql92SelectSelectTableSyntax syntax-                            -> SelectBuilder syntax db a+                            -> a -> BeamSqlBackendSelectTableSyntax be+                            -> SelectBuilder be db a   SelectBuilderTopLevel ::     { sbLimit, sbOffset :: Maybe Integer-    , sbOrdering        :: [ Sql92SelectOrderingSyntax syntax ]-    , sbTable           :: SelectBuilder syntax db a-    , sbSelectFn        :: Maybe (SelectStmtFn syntax)+    , sbOrdering        :: [ BeamSqlBackendOrderingSyntax be ]+    , sbTable           :: SelectBuilder be db a+    , sbSelectFn        :: Maybe (SelectStmtFn be)                         -- ^ Which 'SelectStmtFn' to use to build this select. If 'Nothing', use the default-    } -> SelectBuilder syntax db a+    } -> SelectBuilder be db a  sbContainsSetOperation :: SelectBuilder syntax db a -> Bool sbContainsSetOperation (SelectBuilderSelectSyntax contains _ _) = contains@@ -83,45 +88,43 @@ nextTblPfx :: TablePrefix -> TablePrefix nextTblPfx = ("sub_" <>) -defaultProjection :: Projectible expr x =>-                     TablePrefix -> x -> [ ( expr, Maybe T.Text ) ]-defaultProjection pfx =+defaultProjection :: Projectible be x+                  => Proxy be -> TablePrefix -> x -> [ ( BeamSqlBackendExpressionSyntax be , Maybe T.Text ) ]+defaultProjection be pfx =     zipWith (\i e -> (e, Just (fromString "res" <> fromString (show (i :: Integer)))))-            [0..] . flip project (nextTblPfx pfx)+            [0..] . flip (project be) (nextTblPfx pfx) -buildSelect :: ( IsSql92SelectSyntax syntax-               , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) a ) =>-               TablePrefix -> SelectBuilder syntax db a -> syntax+buildSelect :: forall be db a+             . ( BeamSqlBackend be, Projectible be a )+            => TablePrefix -> SelectBuilder be db a -> BeamSqlBackendSelectSyntax be buildSelect _ (SelectBuilderTopLevel limit offset ordering (SelectBuilderSelectSyntax _ _ table) selectStmt') =     (fromMaybe selectStmt selectStmt') table ordering limit offset buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderQ proj (QueryBuilder _ from where_)) selectStmt') =-    (fromMaybe selectStmt selectStmt') (selectTableStmt Nothing (projExprs (defaultProjection pfx proj)) from where_ Nothing Nothing) ordering limit offset+    (fromMaybe selectStmt selectStmt') (selectTableStmt Nothing (projExprs (defaultProjection (Proxy @be) pfx proj)) from where_ Nothing Nothing) ordering limit offset buildSelect pfx (SelectBuilderTopLevel limit offset ordering (SelectBuilderGrouping proj (QueryBuilder _ from where_) grouping having distinct) selectStmt') =-    (fromMaybe selectStmt selectStmt') (selectTableStmt distinct (projExprs (defaultProjection pfx proj)) from where_ grouping having) ordering limit offset+    (fromMaybe selectStmt selectStmt') (selectTableStmt distinct (projExprs (defaultProjection (Proxy @be) pfx proj)) from where_ grouping having) ordering limit offset buildSelect pfx x = buildSelect pfx (SelectBuilderTopLevel Nothing Nothing [] x Nothing) -selectBuilderToTableSource :: ( Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax-                              , IsSql92SelectSyntax syntax-                              , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) a ) =>-                              TablePrefix -> SelectBuilder syntax db a -> Sql92SelectSelectTableSyntax syntax+selectBuilderToTableSource :: forall be db a+                            . ( BeamSqlBackend be, Projectible be a )+                           => TablePrefix -> SelectBuilder be db a -> BeamSqlBackendSelectTableSyntax be selectBuilderToTableSource _ (SelectBuilderSelectSyntax _ _ x) = x selectBuilderToTableSource pfx (SelectBuilderQ x (QueryBuilder _ from where_)) =-  selectTableStmt Nothing (projExprs (defaultProjection pfx x)) from where_ Nothing Nothing+  selectTableStmt Nothing (projExprs (defaultProjection (Proxy @be) pfx x)) from where_ Nothing Nothing selectBuilderToTableSource pfx (SelectBuilderGrouping x (QueryBuilder _ from where_) grouping having distinct) =-  selectTableStmt distinct (projExprs (defaultProjection pfx x)) from where_ grouping having+  selectTableStmt distinct (projExprs (defaultProjection (Proxy @be) pfx x)) from where_ grouping having selectBuilderToTableSource pfx sb =     let (x, QueryBuilder _ from where_) = selectBuilderToQueryBuilder pfx sb-    in selectTableStmt Nothing (projExprs (defaultProjection pfx x)) from where_ Nothing Nothing+    in selectTableStmt Nothing (projExprs (defaultProjection (Proxy @be) pfx x)) from where_ Nothing Nothing -selectBuilderToQueryBuilder :: ( Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax syntax)) ~ syntax-                               , IsSql92SelectSyntax syntax-                               , Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) a ) =>-                               TablePrefix -> SelectBuilder syntax db a -> (a, QueryBuilder syntax)+selectBuilderToQueryBuilder :: forall be db a+                             . ( BeamSqlBackend be, Projectible be a)+                            => TablePrefix -> SelectBuilder be db a -> (a, QueryBuilder be) selectBuilderToQueryBuilder pfx sb =     let select = buildSelect pfx sb-        x' = reproject (fieldNameFunc (qualifiedField t0)) (sbProj sb)+        x' = reproject (Proxy @be) (fieldNameFunc (qualifiedField t0)) (sbProj sb)         t0 = pfx <> "0"-    in (x', QueryBuilder 1 (Just (fromTable (tableFromSubSelect select) (Just t0))) Nothing)+    in (x', QueryBuilder 1 (Just (fromTable (tableFromSubSelect select) (Just (t0, Nothing)))) Nothing)  emptyQb :: QueryBuilder select emptyQb = QueryBuilder 0 Nothing Nothing@@ -132,8 +135,8 @@ sbProj (SelectBuilderSelectSyntax _ proj _) = proj sbProj (SelectBuilderTopLevel _ _ _ sb _) = sbProj sb -setSelectBuilderProjection :: Projectible (Sql92ProjectionExpressionSyntax (Sql92SelectProjectionSyntax syntax)) b =>-                              SelectBuilder syntax db a -> b -> SelectBuilder syntax db b+setSelectBuilderProjection :: Projectible be b+                           => SelectBuilder be db a -> b -> SelectBuilder be db b setSelectBuilderProjection (SelectBuilderQ _ q) proj = SelectBuilderQ proj q setSelectBuilderProjection (SelectBuilderGrouping _ q grouping having d) proj = SelectBuilderGrouping proj q grouping having d setSelectBuilderProjection (SelectBuilderSelectSyntax containsSetOp _ q) proj = SelectBuilderSelectSyntax containsSetOp proj q@@ -155,29 +158,29 @@ exprWithContext pfx = ($ nextTblPfx pfx)  buildJoinTableSourceQuery-  :: ( IsSql92SelectSyntax select-     , Projectible (Sql92SelectExpressionSyntax select) x-     , Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax select)) ~ select )-  => TablePrefix -> select-  -> x -> QueryBuilder select-  -> (x, QueryBuilder select)+  :: forall be x+   . ( BeamSqlBackend be, Projectible be x )+  => TablePrefix -> BeamSqlBackendSelectSyntax be+  -> x -> QueryBuilder be+  -> (x, QueryBuilder be) buildJoinTableSourceQuery tblPfx tblSource x qb =   let qb' = QueryBuilder (tblRef + 1) from' (qbWhere qb)       !tblRef = qbNextTblRef qb       from' = case qbFrom qb of                 Nothing -> Just newSource                 Just oldFrom -> Just (innerJoin oldFrom newSource Nothing)-      newSource = fromTable (tableFromSubSelect tblSource) (Just newTblNm)+      newSource = fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing))       newTblNm = tblPfx <> fromString (show tblRef)-  in (reproject (fieldNameFunc (qualifiedField newTblNm)) x, qb')+  in (reproject (Proxy @be) (fieldNameFunc (qualifiedField newTblNm)) x, qb')  buildInnerJoinQuery-    :: forall select s table-     . (Beamable table, IsSql92SelectSyntax select)-    => TablePrefix -> (TablePrefix -> T.Text -> Sql92SelectFromSyntax select) -> TableSettings table-    -> (table (QExpr (Sql92SelectExpressionSyntax select) s) -> Maybe (WithExprContext (Sql92SelectExpressionSyntax select)))-    -> QueryBuilder select -> (T.Text, table (QExpr (Sql92SelectExpressionSyntax select) s), QueryBuilder select)-buildInnerJoinQuery tblPfx mkFrom tblSettings mkOn qb =+  :: forall be r+   . BeamSqlBackend be+  => TablePrefix -> (TablePrefix -> T.Text -> BeamSqlBackendFromSyntax be)+  -> (T.Text -> r)+  -> (r-> Maybe (WithExprContext (BeamSqlBackendExpressionSyntax be)))+  -> QueryBuilder be -> (T.Text, r, QueryBuilder be)+buildInnerJoinQuery tblPfx mkFrom mkTbl mkOn qb =   let qb' = QueryBuilder (tblRef + 1) from' where'       tblRef = qbNextTblRef qb       newTblNm = tblPfx <> fromString (show tblRef)@@ -187,48 +190,42 @@           Nothing -> (Just newSource, andE' (qbWhere qb) (exprWithContext tblPfx <$> mkOn newTbl))           Just oldFrom -> (Just (innerJoin oldFrom newSource (exprWithContext tblPfx <$> mkOn newTbl)), qbWhere qb) -      newTbl = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (\_ -> fieldE (qualifiedField newTblNm (_fieldName f))))) tblSettings+      newTbl = mkTbl newTblNm   in (newTblNm, newTbl, qb') -nextTbl :: (IsSql92SelectSyntax select, Beamable table)-        => QueryBuilder select-        -> TablePrefix -> TableSettings table-        -> ( table (QExpr (Sql92SelectExpressionSyntax select) s)-           , T.Text-           , QueryBuilder select )-nextTbl qb tblPfx tblSettings =+nextTbl :: BeamSqlBackend be+        => QueryBuilder be -> TablePrefix+        -> (T.Text -> r)+        -> ( r, T.Text, QueryBuilder be )+nextTbl qb tblPfx mkTbl =   let tblRef = qbNextTblRef qb       newTblNm = tblPfx <> fromString (show tblRef)-      newTbl = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (\_ -> fieldE (qualifiedField newTblNm (_fieldName f))))) tblSettings+      newTbl = mkTbl newTblNm   in (newTbl, newTblNm, qb { qbNextTblRef = qbNextTblRef qb + 1}) -projOrder :: Projectible expr x =>-             x -> WithExprContext [ expr ]+projOrder :: Projectible be x+          => Proxy be -> x -> WithExprContext [ BeamSqlBackendExpressionSyntax be ] projOrder = project -- (Proxy @AnyType) (\_ x -> tell [x] >> pure x)  -- | Convenience functions to construct an arbitrary SQL92 select syntax type -- from a 'Q'. Used by most backends as the default implementation of -- 'buildSqlQuery' in 'HasQBuilder'.-buildSql92Query' ::-    forall select projSyntax db s a.-    ( IsSql92SelectSyntax select-    , Eq (Sql92SelectExpressionSyntax select)-    , projSyntax ~ Sql92SelectTableProjectionSyntax (Sql92SelectSelectTableSyntax select)-    , Sql92TableSourceSelectSyntax (Sql92FromTableSourceSyntax (Sql92SelectFromSyntax select)) ~ select--    , Sql92ProjectionExpressionSyntax projSyntax ~ Sql92SelectExpressionSyntax select-    , Projectible (Sql92ProjectionExpressionSyntax projSyntax) a ) =>-    Bool {-^ Whether this backend supports arbitrary nested UNION, INTERSECT, EXCEPT -} ->-    T.Text {-^ Table prefix -} ->-    Q select db s a ->-    select+buildSql92Query' :: forall be db s a+                  . ( BeamSqlBackend be, Projectible be a)+                 => Bool {-^ Whether this backend supports arbitrary nested UNION, INTERSECT, EXCEPT -}+                 -> T.Text {-^ Table prefix -}+                 -> Q be db s a+                 -> BeamSqlBackendSelectSyntax be buildSql92Query' arbitrarilyNestedCombinations tblPfx (Q q) =     buildSelect tblPfx (buildQuery (fromF q))   where-    buildQuery :: forall s x.-                  Projectible (Sql92ProjectionExpressionSyntax projSyntax) x =>-                  Free (QF select db s) x-               -> SelectBuilder select db x+    be :: Proxy be+    be = Proxy++    buildQuery :: forall s x+                . Projectible be x+               => Free (QF be db s) x+               -> SelectBuilder be db x     buildQuery (Pure x) = SelectBuilderQ x emptyQb     buildQuery (Free (QGuard _ next)) = buildQuery next     buildQuery f@(Free QAll {}) = buildJoinedQuery f emptyQb@@ -364,12 +361,8 @@              _ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb                   in buildJoinedQuery (next x') qb -    buildQuery (Free (QUnion all_ left right next)) =-      buildTableCombination (unionTables all_) left right next-    buildQuery (Free (QIntersect all_ left right next)) =-      buildTableCombination (intersectTables all_) left right next-    buildQuery (Free (QExcept all_ left right next)) =-      buildTableCombination (exceptTable all_) left right next+    buildQuery (Free (QSetOp combine left right next)) =+      buildTableCombination combine left right next      buildQuery (Free (QForceSelect selectStmt' over next)) =       let sb = buildQuery (fromF over)@@ -388,35 +381,34 @@            _ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb'                 in buildJoinedQuery (next x') qb -    tryBuildGuardsOnly :: forall s x.-                          Free (QF select db s) x-                       -> Maybe (Sql92SelectExpressionSyntax select)-                       -> Maybe (x, Maybe (Sql92SelectExpressionSyntax select))+    tryBuildGuardsOnly :: forall s x+                        . Free (QF be db s) x+                       -> Maybe (BeamSqlBackendExpressionSyntax be)+                       -> Maybe (x, Maybe (BeamSqlBackendExpressionSyntax be))     tryBuildGuardsOnly next having =       case tryCollectHaving next having of         (Pure x, having') -> Just (x, having')         _ -> Nothing      tryCollectHaving :: forall s x.-                        Free (QF select db s) x-                     -> Maybe (Sql92SelectExpressionSyntax select)-                     -> (Free (QF select db s) x, Maybe (Sql92SelectExpressionSyntax select))+                        Free (QF be db s) x+                     -> Maybe (BeamSqlBackendExpressionSyntax be)+                     -> (Free (QF be db s) x, Maybe (BeamSqlBackendExpressionSyntax be))     tryCollectHaving (Free (QGuard cond next)) having = tryCollectHaving next (andE' having (Just (exprWithContext tblPfx cond)))     tryCollectHaving next having = (next, having) -    buildTableCombination ::-      forall s x r.-        ( Projectible (Sql92ProjectionExpressionSyntax projSyntax) r-        , Projectible (Sql92ProjectionExpressionSyntax projSyntax) x ) =>-        (Sql92SelectSelectTableSyntax select -> Sql92SelectSelectTableSyntax select -> Sql92SelectSelectTableSyntax select) ->-        QM select db (QNested s) x -> QM select db (QNested s) x -> (x -> Free (QF select db s) r) -> SelectBuilder select db r+    buildTableCombination+      :: forall s x r+       . ( Projectible be r, Projectible be x )+      => (BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be -> BeamSqlBackendSelectTableSyntax be)+      -> QM be db (QNested s) x -> QM be db (QNested s) x -> (x -> Free (QF be db s) r) -> SelectBuilder be db r     buildTableCombination combineTables left right next =         let leftSb = buildQuery (fromF left)             leftTb = selectBuilderToTableSource tblPfx leftSb             rightSb = buildQuery (fromF right)             rightTb = selectBuilderToTableSource tblPfx rightSb -            proj = reproject (fieldNameFunc unqualifiedField) (sbProj leftSb)+            proj = reproject be (fieldNameFunc unqualifiedField) (sbProj leftSb)              leftTb' | arbitrarilyNestedCombinations = leftTb                     | sbContainsSetOperation leftSb =@@ -432,22 +424,22 @@             sb = SelectBuilderSelectSyntax True proj (combineTables leftTb' rightTb')         in case next proj of              Pure proj'-               | projOrder proj (nextTblPfx tblPfx) == projOrder proj' (nextTblPfx tblPfx) ->+               | projOrder be proj (nextTblPfx tblPfx) == projOrder be proj' (nextTblPfx tblPfx) ->                    setSelectBuilderProjection sb proj'              _ -> let (x', qb) = selectBuilderToQueryBuilder tblPfx sb                   in buildJoinedQuery (next x') qb      buildJoinedQuery :: forall s x.-                        Projectible (Sql92ProjectionExpressionSyntax projSyntax) x =>-                        Free (QF select db s) x -> QueryBuilder select -> SelectBuilder select db x+                        Projectible be x =>+                        Free (QF be db s) x -> QueryBuilder be -> SelectBuilder be db x     buildJoinedQuery (Pure x) qb = SelectBuilderQ x qb-    buildJoinedQuery (Free (QAll mkFrom tblSettings on next)) qb =-        let (newTblNm, newTbl, qb') = buildInnerJoinQuery tblPfx mkFrom tblSettings on qb+    buildJoinedQuery (Free (QAll mkFrom mkTbl on next)) qb =+        let (newTblNm, newTbl, qb') = buildInnerJoinQuery tblPfx mkFrom mkTbl on qb         in buildJoinedQuery (next (newTblNm, newTbl)) qb'     buildJoinedQuery (Free (QArbitraryJoin q mkJoin on next)) qb =       case fromF q of-        Free (QAll mkDbFrom dbTblSettings on' next')-          | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblSettings,+        Free (QAll mkDbFrom dbMkTbl on' next')+          | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,             Nothing <- exprWithContext tblPfx <$> on' newTbl,             Pure proj <- next' (newTblNm, newTbl) ->             let newSource = mkDbFrom (nextTblPfx tblPfx) newTblNm@@ -462,9 +454,9 @@                   tblSource = buildSelect tblPfx sb                   newTblNm = tblPfx <> fromString (show (qbNextTblRef qb)) -                  newSource = fromTable (tableFromSubSelect tblSource) (Just newTblNm)+                  newSource = fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing)) -                  proj' = reproject (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)+                  proj' = reproject be (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)                   on' = exprWithContext tblPfx <$> on proj'                    (from', where') =@@ -477,8 +469,8 @@     buildJoinedQuery (Free (QTwoWayJoin a b mkJoin on next)) qb =       let (aProj, aSource, qb') =             case fromF a of-              Free (QAll mkDbFrom dbTblSettings on' next')-                | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbTblSettings,+              Free (QAll mkDbFrom dbMkTbl on' next')+                | (newTbl, newTblNm, qb') <- nextTbl qb tblPfx dbMkTbl,                   Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->                     (proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb') @@ -487,13 +479,13 @@                         newTblNm = tblPfx <> fromString (show (qbNextTblRef qb)) -                       proj' = reproject (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)-                   in (proj', fromTable (tableFromSubSelect tblSource) (Just newTblNm), qb { qbNextTblRef = qbNextTblRef qb + 1 })+                       proj' = reproject be (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)+                   in (proj', fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing)), qb { qbNextTblRef = qbNextTblRef qb + 1 })            (bProj, bSource, qb'') =             case fromF b of-              Free (QAll mkDbFrom dbTblSettings on' next')-                | (newTbl, newTblNm, qb'') <- nextTbl qb' tblPfx dbTblSettings,+              Free (QAll mkDbFrom dbMkTbl on' next')+                | (newTbl, newTblNm, qb'') <- nextTbl qb' tblPfx dbMkTbl,                   Nothing <- on' newTbl, Pure proj <- next' (newTblNm, newTbl) ->                     (proj, mkDbFrom (nextTblPfx tblPfx) newTblNm, qb'') @@ -502,8 +494,8 @@                         newTblNm = tblPfx <> fromString (show (qbNextTblRef qb)) -                       proj' = reproject (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)-                   in (proj', fromTable (tableFromSubSelect tblSource) (Just newTblNm), qb { qbNextTblRef = qbNextTblRef qb + 1 })+                       proj' = reproject be (fieldNameFunc (qualifiedField newTblNm)) (sbProj sb)+                   in (proj', fromTable (tableFromSubSelect tblSource) (Just (newTblNm, Nothing)), qb { qbNextTblRef = qbNextTblRef qb + 1 })            abSource = mkJoin aSource bSource (exprWithContext tblPfx <$> on (aProj, bProj)) @@ -524,11 +516,12 @@            in buildJoinedQuery (next x') qb')      onlyQ :: forall s x.-             Free (QF select db s) x-          -> (forall a'. Projectible (Sql92SelectExpressionSyntax select) a' => Free (QF select db s) a' -> (a' -> Free (QF select db s) x) -> SelectBuilder select db x)-          -> SelectBuilder select db x-    onlyQ (Free (QAll entityNm entitySettings mkOn next)) f =-      f (Free (QAll entityNm entitySettings mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)+             Free (QF be db s) x+          -> (forall a'. Projectible be a' => Free (QF be db s) a' -> (a' -> Free (QF be db s) x) -> SelectBuilder be db x)+          -> SelectBuilder be db x+    onlyQ (Free (QAll entityNm mkTbl mkOn next)) f =+      f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)+--      f (Free (QAll entityNm mkTbl mkOn (Pure . PreserveLeft))) (next . unPreserveLeft)     onlyQ (Free (QArbitraryJoin entity mkJoin mkOn next)) f =       f (Free (QArbitraryJoin entity mkJoin mkOn Pure)) next     onlyQ (Free (QTwoWayJoin a b mkJoin mkOn next)) f =@@ -539,12 +532,8 @@       f (Free (QLimit limit q' Pure)) next     onlyQ (Free (QOffset offset q' next)) f =       f (Free (QOffset offset q' Pure)) next-    onlyQ (Free (QUnion all_ a b next)) f =-      f (Free (QUnion all_ a b Pure)) next-    onlyQ (Free (QIntersect all_ a b next)) f =-      f (Free (QIntersect all_ a b Pure)) next-    onlyQ (Free (QExcept all_ a b next)) f =-      f (Free (QExcept all_ a b Pure)) next+    onlyQ (Free (QSetOp combine a b next)) f =+      f (Free (QSetOp combine a b Pure)) next     onlyQ (Free (QOrderBy mkOrdering q' next)) f =       f (Free (QOrderBy mkOrdering q' Pure)) next     onlyQ (Free (QWindowOver mkWindow mkProj q' next)) f =

@@ -1,7 +1,8 @@+{-# LANGUAGE UndecidableInstances #-} module Database.Beam.Query.Types-  ( Q, QExpr, QGenExpr(..), QExprToIdentity, QExprToField, QWindow, QWindowFrame+  ( Q, QExpr, QGenExpr(..), QExprToIdentity, QExprToField, QWindow -  , Projectible, Aggregation+  , Projectible    , HasQBuilder(..) ) where @@ -10,9 +11,9 @@  import Database.Beam.Schema.Tables -import Database.Beam.Backend.SQL.Builder-import Database.Beam.Backend.SQL.AST-import Database.Beam.Backend.SQL.SQL92+import Database.Beam.Backend.SQL+-- import Database.Beam.Backend.SQL.Builder+-- import Database.Beam.Backend.SQL.AST  import Control.Monad.Identity import Data.Vector.Sized (Vector)@@ -56,10 +57,10 @@   , QExprToField e, QExprToField f, QExprToField g, QExprToField h) type instance QExprToField (Vector n a) = Vector n (QExprToField a) -class IsSql92SelectSyntax selectSyntax => HasQBuilder selectSyntax where-  buildSqlQuery :: Projectible (Sql92SelectExpressionSyntax selectSyntax) a =>-                   TablePrefix -> Q selectSyntax db s a -> selectSyntax-instance HasQBuilder SqlSyntaxBuilder where-  buildSqlQuery = buildSql92Query' True-instance HasQBuilder Select where+class BeamSqlBackend be => HasQBuilder be where+  buildSqlQuery :: Projectible be a+                => TablePrefix -> Q be db s a -> BeamSqlBackendSelectSyntax be+instance BeamSqlBackend (MockSqlBackend cmd) => HasQBuilder (MockSqlBackend cmd) where   buildSqlQuery = buildSql92Query' True+-- instance HasQBuilder Select where+--   buildSqlQuery = buildSql92Query' True

@@ -34,6 +34,7 @@     , withDbModification, withTableModification     , dbModification, tableModification     , modifyTable, fieldNamed+    , setEntityName , modifyEntityName, modifyTableFields      -- * Types for lens generation     , Lenses, LensFor(..)

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeApplications #-}@@ -21,7 +22,8 @@     , DatabaseModification, EntityModification(..)     , FieldModification(..)     , dbModification, tableModification, withDbModification-    , withTableModification, modifyTable, fieldNamed+    , withTableModification, modifyTable, modifyEntityName+    , setEntityName, modifyTableFields, fieldNamed     , defaultDbSettings      , RenamableWithRule(..), RenamableField(..)@@ -34,7 +36,7 @@     , ComposeColumnar(..)     , Nullable, TableField(..)     , Exposed-    , fieldName+    , fieldName, fieldPath      , TableSettings, HaskellTable     , TableSkeleton, Ignored(..)@@ -52,18 +54,24 @@     , tableValuesNeeded     , pk     , allBeamValues, changeBeamRep-    , alongsideTable )+    , alongsideTable+    , defaultFieldName )     where  import           Database.Beam.Backend.Types  import           Control.Arrow (first) import           Control.Monad.Identity-import           Control.Monad.Writer+import           Control.Monad.Writer hiding ((<>))  import           Data.Char (isUpper, toLower)-import           Data.Monoid ((<>))+import           Data.Foldable (fold)+import qualified Data.List.NonEmpty as NE+import           Data.Monoid (Endo(..)) import           Data.Proxy+#if !MIN_VERSION_base(4,11,0)+import           Data.Semigroup+#endif import           Data.String (IsString(..)) import           Data.Text (Text) import qualified Data.Text as T@@ -138,7 +146,8 @@ -- | A newtype wrapper around 'f e -> f e' (i.e., an endomorphism between entity --   types in 'f'). You usually want to use 'modifyTable' or another function to --   contstruct these for you.-newtype EntityModification f be e = EntityModification (f e -> f e)+newtype EntityModification f be e = EntityModification (Endo (f e))+  deriving (Monoid, Semigroup) -- | A newtype wrapper around 'Columnar f a -> Columnar f ' (i.e., an --   endomorphism between 'Columnar's over 'f'). You usually want to use --   'fieldNamed' or the 'IsString' instance to rename the field, when 'f ~@@ -152,7 +161,7 @@ -- > dbModification { tbl1 = modifyTable (\oldNm -> "NewTableName") tableModification } dbModification :: forall f be db. Database be db => DatabaseModification f be db dbModification = runIdentity $-                 zipTables (Proxy @be) (\_ _ -> pure (EntityModification id)) (undefined :: DatabaseModification f be db) (undefined :: DatabaseModification f be db)+                 zipTables (Proxy @be) (\_ _ -> pure mempty) (undefined :: DatabaseModification f be db) (undefined :: DatabaseModification f be db)  -- | Return a table modification (for use with 'modifyTable') that does nothing. --   Useful if you only want to change the table name, or if you only want to@@ -185,7 +194,7 @@                    -> DatabaseModification (entity be db) be db                    -> db (entity be db) withDbModification db mods =-  runIdentity $ zipTables (Proxy @be) (\tbl (EntityModification entityFn) -> pure (entityFn tbl)) db mods+  runIdentity $ zipTables (Proxy @be) (\tbl (EntityModification entityFn) -> pure (appEndo entityFn tbl)) db mods  -- | Modify a table according to the given field modifications. Invoked by --   'modifyTable' to apply the modification in the database. Not used as often in@@ -195,30 +204,43 @@   runIdentity $ zipBeamFieldsM (\(Columnar' field :: Columnar' f a) (Columnar' (FieldModification fieldFn :: FieldModification f a)) ->                                   pure (Columnar' (fieldFn field))) tbl mods + -- | Provide an 'EntityModification' for 'TableEntity's. Allows you to modify --   the name of the table and provide a modification for each field in the --   table. See the examples for 'withDbModification' for more.-modifyTable :: (Text -> Text)+modifyTable :: (Beamable tbl, Table tbl)+            => (Text -> Text)             -> tbl (FieldModification (TableField tbl))             -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)-modifyTable modTblNm modFields =-  EntityModification (\(DatabaseEntity (DatabaseTable nm fields)) ->-                         (DatabaseEntity (DatabaseTable (modTblNm nm) (withTableModification modFields fields))))+modifyTable modTblNm modFields = modifyEntityName modTblNm <> modifyTableFields modFields+{-# DEPRECATED modifyTable "Instead of 'modifyTable fTblNm fFields', use 'modifyEntityName _ <> modifyTableFields _'" #-} +-- | Construct an 'EntityModification' to rename any database entity+modifyEntityName :: IsDatabaseEntity be entity => (Text -> Text) -> EntityModification (DatabaseEntity be db) be entity+modifyEntityName modTblNm = EntityModification (Endo (\(DatabaseEntity tbl) -> DatabaseEntity (tbl & dbEntityName %~ modTblNm)))++-- | Change the entity name without consulting the beam-assigned one+setEntityName :: IsDatabaseEntity be entity => Text -> EntityModification (DatabaseEntity be db) be entity+setEntityName nm = modifyEntityName (\_ -> nm)++-- | Construct an 'EntityModification' to rename the fields of a 'TableEntity'+modifyTableFields :: tbl (FieldModification (TableField tbl)) -> EntityModification (DatabaseEntity be db) be (TableEntity tbl)+modifyTableFields modFields = EntityModification (Endo (\(DatabaseEntity tbl@(DatabaseTable {})) -> DatabaseEntity tbl { dbTableSettings = withTableModification modFields (dbTableSettings tbl) }))+ -- | A field modification to rename the field. Also offered under the 'IsString' --   instance for 'FieldModification (TableField tbl) a' for convenience. fieldNamed :: Text -> FieldModification (TableField tbl) a-fieldNamed newName = FieldModification (\_ -> TableField newName)+fieldNamed newName = FieldModification (fieldName .~ newName)  newtype FieldRenamer entity = FieldRenamer { withFieldRenamer :: entity -> entity }  class RenamableField f where-  renameField :: Proxy f -> Proxy a -> (Text -> Text) -> Columnar f a -> Columnar f a+  renameField :: Proxy f -> Proxy a -> (NE.NonEmpty Text -> Text) -> Columnar f a -> Columnar f a instance RenamableField (TableField tbl) where-  renameField _ _ f (TableField nm) = TableField (f nm)+  renameField _ _ f (TableField path _) = TableField path (f path)  class RenamableWithRule mod where-  renamingFields :: (Text -> Text) -> mod+  renamingFields :: (NE.NonEmpty Text -> Text) -> mod instance Database be db => RenamableWithRule (db (EntityModification (DatabaseEntity be db) be)) where   renamingFields renamer =     runIdentity $@@ -227,7 +249,7 @@               (undefined :: DatabaseModification f be db) instance IsDatabaseEntity be entity => RenamableWithRule (EntityModification (DatabaseEntity be db) be entity) where   renamingFields renamer =-    EntityModification (\(DatabaseEntity tbl) -> DatabaseEntity (withFieldRenamer (renamingFields renamer) tbl))+    EntityModification (Endo (\(DatabaseEntity tbl) -> DatabaseEntity (withFieldRenamer (renamingFields renamer) tbl))) instance (Beamable tbl, RenamableField f) => RenamableWithRule (tbl (FieldModification f)) where   renamingFields renamer =     runIdentity $@@ -259,62 +281,84 @@   type DatabaseEntityRegularRequirements be entityType :: Constraint    dbEntityName :: Lens' (DatabaseEntityDescriptor be entityType) Text+  dbEntitySchema :: Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)+   dbEntityAuto :: DatabaseEntityDefaultRequirements be entityType =>                   Text -> DatabaseEntityDescriptor be entityType  instance Beamable tbl => RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (TableEntity tbl))) where   renamingFields renamer =-    FieldRenamer $ \(DatabaseTable tblName fields) ->-    DatabaseTable tblName $-    changeBeamRep (\(Columnar' tblField :: Columnar' (TableField tbl) a) ->-                     Columnar' (renameField (Proxy @(TableField tbl)) (Proxy @a) renamer tblField) :: Columnar' (TableField tbl) a) $-    fields+    FieldRenamer $ \tbl ->+      tbl { dbTableSettings =+              changeBeamRep (\(Columnar' tblField :: Columnar' (TableField tbl) a) ->+                               Columnar' (renameField (Proxy @(TableField tbl))+                                                      (Proxy @a)+                                                      renamer tblField)+                                 :: Columnar' (TableField tbl) a) $+              dbTableSettings tbl }  instance Beamable tbl => IsDatabaseEntity be (TableEntity tbl) where   data DatabaseEntityDescriptor be (TableEntity tbl) where-    DatabaseTable :: Table tbl => Text -> TableSettings tbl -> DatabaseEntityDescriptor be (TableEntity tbl)+    DatabaseTable+      :: Table tbl =>+       { dbTableSchema      :: Maybe Text+       , dbTableOrigName    :: Text+       , dbTableCurrentName :: Text+       , dbTableSettings    :: TableSettings tbl }+      -> DatabaseEntityDescriptor be (TableEntity tbl)   type DatabaseEntityDefaultRequirements be (TableEntity tbl) =     ( GDefaultTableFieldSettings (Rep (TableSettings tbl) ())     , Generic (TableSettings tbl), Table tbl, Beamable tbl )   type DatabaseEntityRegularRequirements be (TableEntity tbl) =     ( Table tbl, Beamable tbl ) -  dbEntityName f (DatabaseTable t s) = fmap (\t' -> DatabaseTable t' s) (f t)+  dbEntityName f tbl = fmap (\t' -> tbl { dbTableCurrentName = t' }) (f (dbTableCurrentName tbl))+  dbEntitySchema f tbl = fmap (\s' -> tbl { dbTableSchema = s'}) (f (dbTableSchema tbl))   dbEntityAuto nm =-    DatabaseTable (unCamelCaseSel nm) defTblFieldSettings+    DatabaseTable Nothing nm (unCamelCaseSel nm) defTblFieldSettings  instance Beamable tbl => RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (ViewEntity tbl))) where   renamingFields renamer =-    FieldRenamer $ \(DatabaseView tblName fields) ->-    DatabaseView tblName $-    changeBeamRep (\(Columnar' tblField :: Columnar' (TableField tbl) a) ->-                     Columnar' (renameField (Proxy @(TableField tbl)) (Proxy @a) renamer tblField) :: Columnar' (TableField tbl) a) $-    fields+    FieldRenamer $ \vw ->+      vw { dbViewSettings =+             changeBeamRep (\(Columnar' tblField :: Columnar' (TableField tbl) a) ->+                              Columnar' (renameField (Proxy @(TableField tbl))+                                                     (Proxy @a)+                                                     renamer tblField)+                                :: Columnar' (TableField tbl) a) $+             dbViewSettings vw }  instance Beamable tbl => IsDatabaseEntity be (ViewEntity tbl) where   data DatabaseEntityDescriptor be (ViewEntity tbl) where-    DatabaseView :: Text -> TableSettings tbl -> DatabaseEntityDescriptor be (ViewEntity tbl)+    DatabaseView+      :: { dbViewSchema :: Maybe Text+         , dbViewOrigName :: Text+         , dbViewCurrentName :: Text+         , dbViewSettings :: TableSettings tbl }+      -> DatabaseEntityDescriptor be (ViewEntity tbl)   type DatabaseEntityDefaultRequirements be (ViewEntity tbl) =     ( GDefaultTableFieldSettings (Rep (TableSettings tbl) ())     , Generic (TableSettings tbl), Beamable tbl )   type DatabaseEntityRegularRequirements be (ViewEntity tbl) =     (  Beamable tbl ) -  dbEntityName f (DatabaseView t s) = fmap (\t' -> DatabaseView t' s) (f t)+  dbEntityName f vw = fmap (\t' -> vw { dbViewCurrentName = t' }) (f (dbViewCurrentName vw))+  dbEntitySchema f vw = fmap (\s' -> vw { dbViewSchema = s' }) (f (dbViewSchema vw))   dbEntityAuto nm =-    DatabaseView (unCamelCaseSel nm) defTblFieldSettings+    DatabaseView Nothing nm (unCamelCaseSel nm) defTblFieldSettings  instance RenamableWithRule (FieldRenamer (DatabaseEntityDescriptor be (DomainTypeEntity ty))) where   renamingFields _ = FieldRenamer id  instance IsDatabaseEntity be (DomainTypeEntity ty) where   data DatabaseEntityDescriptor be (DomainTypeEntity ty)-    = DatabaseDomainType !Text+    = DatabaseDomainType !(Maybe Text) !Text   type DatabaseEntityDefaultRequirements be (DomainTypeEntity ty) = ()   type DatabaseEntityRegularRequirements be (DomainTypeEntity ty) = () -  dbEntityName f (DatabaseDomainType t) = DatabaseDomainType <$> f t-  dbEntityAuto = DatabaseDomainType+  dbEntityName f (DatabaseDomainType s t) = DatabaseDomainType s <$> f t+  dbEntitySchema f (DatabaseDomainType s t) = DatabaseDomainType <$> f s <*> pure t+  dbEntityAuto = DatabaseDomainType Nothing  -- | Represents a meta-description of a particular entityType. Mostly, a wrapper --   around 'DatabaseEntityDescriptor be entityType', but carries around the@@ -446,17 +490,23 @@ -- --   Usually you use the 'defaultDbSettings' function to generate an appropriate --   naming convention for you, and then modify it with 'withDbModification' if---   necessary. Under this scheme, the field can be renamed using the 'IsString'+--   necessary. Under this scheme, the field n be renamed using the 'IsString' --   instance for 'TableField', or the 'fieldNamed' function. data TableField (table :: (* -> *) -> *) ty   = TableField-  { _fieldName :: Text  -- ^ The field name+  { _fieldPath :: NE.NonEmpty T.Text+    -- ^ The path that led to this field. Each element is the haskell+    -- name of the record field in which this table is stored.+  , _fieldName :: Text  -- ^ The field name   } deriving (Show, Eq)  -- | Van Laarhoven lens to retrieve or set the field name from a 'TableField'. fieldName :: Lens' (TableField table ty) Text-fieldName f (TableField name) = TableField <$> f name+fieldName f (TableField path name) = TableField path <$> f name +fieldPath :: Traversal' (TableField table ty) Text+fieldPath f (TableField orig name) = TableField <$> traverse f orig <*> pure name+ -- | Represents a table that contains metadata on its fields. In particular, --   each field of type 'Columnar f a' is transformed into 'TableField table a'. --   You can get or update the name of each field by using the 'fieldName' lens.@@ -784,8 +834,9 @@ instance Selector f  =>     GDefaultTableFieldSettings (S1 f (K1 Generic.R (TableField table field)) p) where     gDefTblFieldSettings (_ :: Proxy (S1 f (K1 Generic.R (TableField table field)) p)) = M1 (K1 s)-        where s = TableField name-              name = unCamelCaseSel (T.pack (selName (undefined :: S1 f (K1 Generic.R (TableField table field)) ())))+        where s = TableField (pure rawSelName) name+              name = unCamelCaseSel rawSelName+              rawSelName = T.pack (selName (undefined :: S1 f (K1 Generic.R (TableField table field)) ()))  instance ( TypeError ('Text "All Beamable types must be record types, so appropriate names can be given to columns")) => GDefaultTableFieldSettings (K1 r f p) where   gDefTblFieldSettings _ = error "impossible"@@ -821,8 +872,8 @@          , GDefaultTableFieldSettings (Rep (rel (TableField rel)) ()) ) =>   SubTableStrategyImpl 'PrimaryKeyStrategy f (PrimaryKey rel) where   namedSubTable _ = primaryKey tbl-    where tbl = changeBeamRep (\(Columnar' (TableField nm) :: Columnar' (TableField rel) a) ->-                                  let c = Columnar' (TableField nm) :: Columnar' (TableField tbl) a+    where tbl = changeBeamRep (\(Columnar' (TableField path nm) :: Columnar' (TableField rel) a) ->+                                  let c = Columnar' (TableField path nm) :: Columnar' (TableField tbl) a                                   in runIdentity (reduceTag (\_ -> pure c) undefined)) $                 to' $ gDefTblFieldSettings (Proxy @(Rep (rel (TableField rel)) ())) instance ( Generic (sub f)@@ -844,10 +895,11 @@     where tbl :: sub f           tbl = namedSubTable (Proxy @strategy) -          relName = unCamelCaseSel (T.pack (selName (undefined :: S1 f' (K1 Generic.R (sub f)) p)))+          origSelName = T.pack (selName (undefined :: S1 f' (K1 Generic.R (sub f)) p))+          relName = unCamelCaseSel origSelName            settings' :: sub f-          settings' = changeBeamRep (reduceTag %~ \(Columnar' (TableField nm)) -> Columnar' (TableField (relName <> "__" <> nm))) tbl+          settings' = changeBeamRep (reduceTag %~ \(Columnar' (TableField path nm)) -> Columnar' (TableField (pure origSelName <> path) (relName <> "__" <> nm))) tbl  type family ReplaceBaseTag tag f where   ReplaceBaseTag tag (Nullable f) = Nullable (ReplaceBaseTag tag f)@@ -859,9 +911,9 @@                (Columnar' f' a' -> m (Columnar' f' a'))             -> Columnar' f a -> m (Columnar' f a) instance TagReducesTo (TableField tbl) (TableField tbl) where-  reduceTag f ~(Columnar' (TableField nm)) =-    (\(Columnar' (TableField nm')) -> Columnar' (TableField nm')) <$>-    f (Columnar' (TableField nm))+  reduceTag f ~(Columnar' (TableField path nm)) =+    (\(Columnar' (TableField path' nm')) -> Columnar' (TableField path' nm')) <$>+    f (Columnar' (TableField path nm)) instance TagReducesTo f f' => TagReducesTo (Nullable f) f' where   reduceTag fn ~(Columnar' x :: Columnar' (Nullable f) a) =     (\(Columnar' x' :: Columnar' f (Maybe a')) -> Columnar' x') <$>@@ -933,3 +985,7 @@                  [] -> symbolLeft                  [xs] -> xs                  _:xs -> T.intercalate "_" xs++-- | Produce the beam default field name for the given path+defaultFieldName :: NE.NonEmpty Text -> Text+defaultFieldName comps = fold (NE.intersperse (T.pack "__") (unCamelCaseSel <$> comps))