packages feed

hasqlator-mysql 0.1.0 → 0.2.0

raw patch · 3 files changed

+373/−128 lines, 3 files

Files

hasqlator-mysql.cabal view
@@ -1,5 +1,5 @@ Name:		hasqlator-mysql-Version: 	0.1.0+Version: 	0.2.0 Synopsis:	composable SQL generation Category: 	Database Copyright: 	Kristof Bastiaensen (2020)
src/Database/MySQL/Hasqlator.hs view
@@ -23,7 +23,7 @@  module Database.MySQL.Hasqlator   ( -- * Querying-    Query, Command, select, mergeSelect, replaceSelect,+    Query, Command, select, unionDistinct, unionAll, mergeSelect, replaceSelect,      -- * Query Clauses     QueryClauses, from, innerJoin, leftJoin, rightJoin, outerJoin, emptyJoins,@@ -31,7 +31,7 @@     orderBy, limit, limitOffset,      -- * Selectors-    Selector, as,+    Selector, as, forUpdate, forShare, shareMode, WaitLock,      -- ** polymorphic selector     sel,@@ -54,10 +54,13 @@      -- * Insertion     Insertor, insertValues, insertUpdateValues, insertSelect, insertData,-    skipInsert, into, exprInto, Getter, lensInto, insertOne, ToSql,+    skipInsert, into, exprInto, Getter, lensInto, insertOne, ToSql, insertLess,      -- * Updates     update,++    -- * Deletes+    delete,          -- * Rendering Queries     renderStmt, renderPreparedStmt, SQLError(..), QueryBuilder,@@ -77,7 +80,7 @@ import Control.Monad.Except import Data.Monoid hiding ((<>)) import Data.String hiding (unwords)-import Data.List hiding (unwords)+import Data.List (intersperse) import qualified Data.DList as DList import GHC.Generics hiding (Selector, from) import qualified GHC.Generics as Generics (from)@@ -102,6 +105,7 @@ import qualified Data.Aeson as Aeson import qualified Data.Aeson.Text as Aeson import qualified Data.Text.Lazy as LazyText+import Data.Maybe (mapMaybe)  class FromSql a where   fromSql :: MySQLValue -> Either SQLError a@@ -129,11 +133,15 @@ -- `SQLError` exception.  See the mysql-haskell package for other -- exceptions it may throw. executeQuery :: MySQLConn -> Query a -> IO [a]-executeQuery conn q@(Query s _) =-  do is <- fmap snd $ MySQL.query_ conn $ MySQL.Query $ renderStmt q+executeQuery conn q =+  do let getSelector :: Query a -> Selector a+         getSelector (Query s _) = s+         getSelector (UnionAll q1 _) = getSelector q1+         getSelector (UnionDistinct q1 _) = getSelector q1+     is <- fmap snd $ MySQL.query_ conn $ MySQL.Query $ renderStmt q      results <- Streams.toList is-     for results $ either throw pure . runSelector s-+     for results $ either throw pure . runSelector (getSelector q)+      -- | Execute a Command which doesn't return a result-set. May throw a -- `SQLError` exception.  See the mysql-haskell package for other -- exceptions it may throw.@@ -241,12 +249,17 @@ instance Monoid a => Monoid (Selector a) where   mempty = pure mempty +-- | `Query a` represents a query returning values of type `a`. data Query a = Query (Selector a) QueryBody+             | UnionAll (Query a) (Query a)+             | UnionDistinct (Query a) (Query a)+-- | A command is a database query that doesn't return a value, but is+-- executed for the side effect (inserting, updating, deleteing). data Command = Update [QueryBuilder] [(QueryBuilder, QueryBuilder)] QueryBody              | InsertSelect QueryBuilder [QueryBuilder] [QueryBuilder] QueryBody              | forall a.InsertValues QueryBuilder (Insertor a)                (Maybe [(QueryBuilder, QueryBuilder)]) [a]-             | forall a.Delete (Query a)+             | Delete QueryBuilder QueryClauses  -- | An @`Insertor` a@ provides a mapping of parts of values of type -- @a@ to columns in the database.  Insertors can be combined using `<>`.@@ -266,7 +279,8 @@     , toQueryBuilder body     ]  -  toQueryBuilder (InsertValues _ _ _  []) = "SELECT 'nothing to insert'"+  toQueryBuilder (InsertValues table _ _  []) =+    unwords ["INSERT INTO", table, "SELECT * FROM", table, "WHERE false"]   toQueryBuilder (InsertValues table (Insertor cols convert) updates values__) =     let valuesB = commaSep $                   map (parentized . commaSep . convert)@@ -288,8 +302,9 @@     , "SELECT", parentized $ commaSep rows     , toQueryBuilder queryBody     ]-  toQueryBuilder (Delete query__) =-    "DELETE " <> toQueryBuilder query__+  toQueryBuilder (Delete fields (QueryClauses query__)) =+    "DELETE " <> fields <> " " <> toQueryBuilder body+    where body = appEndo query__ emptyQueryBody  instance ToQueryBuilder QueryBody where   toQueryBuilder body =@@ -300,7 +315,8 @@     (groupByB $ _groupBy body) <>     renderPredicates "HAVING" (_having body) <>     orderByB (_orderBy body) <>-    limitB (_limit body)+    limitB (_limit body) <>+    lockModeB (_lockMode body)     where       fromB Nothing = []       fromB (Just table) = ["FROM", table]@@ -322,9 +338,31 @@         [ "LIMIT" , fromString (show count)         , "OFFSET", fromString (show offset) ] +      lockModeB Nothing = []+      lockModeB (Just (ForUpdate tables waitlock)) =+        ["FOR UPDATE"] <> updateTablesB tables <> waitLockB waitlock+      lockModeB (Just (ForShare tables waitlock)) =+        ["FOR SHARE"] <> updateTablesB tables <> waitLockB waitlock+      lockModeB (Just ShareMode) = ["LOCK IN SHARE MODE"]++      waitLockB NoWaitLock = ["NOWAIT"]+      waitLockB WaitLock = []+      waitLockB SkipLocked = ["SKIP LOCKED"]++      updateTablesB [] = []+      updateTablesB t = ["OF", commaSep t]+ instance ToQueryBuilder (Query a) where   toQueryBuilder (Query (Selector dl _) body) =     "SELECT " <> commaSep (DList.toList dl) <> " " <> toQueryBuilder body+  toQueryBuilder (UnionAll q1 q2) =+    parentized (toQueryBuilder q1) <>+    " UNION ALL " <>+    parentized (toQueryBuilder q2)+  toQueryBuilder (UnionDistinct q1 q2) =+    parentized (toQueryBuilder q1) <>+    " UNION " <>+    parentized (toQueryBuilder q2)  rawSql :: Text -> QueryBuilder rawSql t = QueryBuilder builder builder DList.empty where@@ -336,6 +374,13 @@   toQueryBuilder RightJoin = "RIGHT JOIN"   toQueryBuilder OuterJoin = "OUTER JOIN" +data WaitLock = NoWaitLock | WaitLock | SkipLocked++data LockMode =+  ForUpdate [QueryBuilder] WaitLock |+  ForShare [QueryBuilder] WaitLock |+  ShareMode+ data QueryBody = QueryBody   { _from :: Maybe QueryBuilder   , _joins :: [Join]@@ -344,6 +389,7 @@   , _having :: [QueryBuilder]   , _orderBy :: [QueryOrdering]   , _limit :: Maybe (Int, Maybe Int)+  , _lockMode :: Maybe LockMode   }  data QueryOrdering = @@ -379,24 +425,6 @@ instance Contravariant Insertor where   contramap f (Insertor x g) = Insertor x (g . f) -class HasQueryClauses a where-  mergeClauses :: a -> QueryClauses -> a--instance HasQueryClauses (Query a) where-  mergeClauses (Query selector body) (QueryClauses clauses) =-    Query selector (clauses `appEndo` body)--instance HasQueryClauses Command where-  mergeClauses (Update table setting body) (QueryClauses clauses) =-    Update table setting (clauses `appEndo` body)-  mergeClauses (InsertSelect table toColumns fromColumns queryBody)-    (QueryClauses clauses) =-    InsertSelect table toColumns fromColumns (appEndo clauses queryBody)-  mergeClauses command__@InsertValues{} _ =-    command__-  mergeClauses (Delete query__) clauses =-    Delete $ mergeClauses query__ clauses-   fromText :: Text -> QueryBuilder fromText s = QueryBuilder b b DList.empty   where b = Builder.byteString $ Text.encodeUtf8 s@@ -476,19 +504,25 @@ sum_ x = fun "sum" [x]  false_, true_ :: QueryBuilder+-- | False false_ = rawSql "false"+-- | True true_ = rawSql "true" +-- | VALUES values :: QueryBuilder -> QueryBuilder values x = fun "values" [x] +-- | IS NULL isNull :: QueryBuilder -> QueryBuilder isNull e = parentized $ e <> " IS NULL" +-- | IS NOT NULL expression isNotNull :: QueryBuilder -> QueryBuilder isNotNull e = parentized $ e <> " IS NOT NULL" --- | insert an expression+-- | insert an SQL expression.  Takes a function that generates the+-- SQL expression from the input. exprInto :: (a -> QueryBuilder) -> Text -> Insertor a exprInto f s = Insertor [s] (\t -> [f t]) @@ -560,9 +594,11 @@ lensInto :: ToSql b => Getter a b -> Text -> Insertor a lensInto lens = into (getConst . lens Const) +-- | (<subquery>) subQuery :: ToQueryBuilder a => a -> QueryBuilder subQuery = parentized . toQueryBuilder-  ++-- | FROM table from :: QueryBuilder -> QueryClauses from table = QueryClauses $ Endo $ \qc -> qc {_from = Just table} @@ -570,71 +606,134 @@ joinClause tp tables conditions = QueryClauses $ Endo $ \qc ->   qc { _joins = Join tp tables conditions : _joins qc } -innerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses+-- | INNER JOIN table1, ... ON cond1, cond2, ...+innerJoin ::+  -- | tables+  [QueryBuilder] ->+  -- | on expressions, joined by AND+  [QueryBuilder] ->+  QueryClauses innerJoin = joinClause InnerJoin -leftJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses+-- | LEFT JOIN+leftJoin ::+  -- | tables+  [QueryBuilder] ->+  -- | on expressions, joined by AND+  [QueryBuilder] ->+  QueryClauses leftJoin = joinClause LeftJoin -rightJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses+-- | RIGHT JOIN+rightJoin ::+  -- | tables+  [QueryBuilder] ->+  -- | on expressions, joined by AND+  [QueryBuilder] ->+  QueryClauses rightJoin = joinClause RightJoin -outerJoin :: [QueryBuilder] -> [QueryBuilder] -> QueryClauses+-- | OUTER JOIN+outerJoin ::+  -- | tables+  [QueryBuilder] ->+  -- | on expressions, joined by AND+  [QueryBuilder] ->+  QueryClauses outerJoin = joinClause OuterJoin +-- | remove all existing joins emptyJoins :: QueryClauses emptyJoins = QueryClauses $ Endo $ \qc ->   qc { _joins = [] } +-- | WHERE expression1, expression2, ... where_ :: [QueryBuilder] -> QueryClauses where_ conditions = QueryClauses $ Endo $ \qc ->   qc { _where_ = reverse conditions ++ _where_ qc} +-- | remove all existing where expressions emptyWhere :: QueryClauses emptyWhere = QueryClauses $ Endo $ \qc ->   qc { _where_ = [] } +-- | GROUP BY e1, e2, ... groupBy_ :: [QueryBuilder] -> QueryClauses groupBy_ columns = QueryClauses $ Endo $ \qc ->   qc { _groupBy = columns } +-- | HAVING e1, e2, ... having :: [QueryBuilder] -> QueryClauses having conditions = QueryClauses $ Endo $ \qc ->   qc { _having = reverse conditions ++ _having qc } +-- | remove having expression emptyHaving :: QueryClauses emptyHaving = QueryClauses $ Endo $ \qc ->   qc { _having = [] } +-- | ORDER BY e1, e2, ... orderBy :: [QueryOrdering] -> QueryClauses orderBy ordering = QueryClauses $ Endo $ \qc ->   qc { _orderBy = ordering } +-- | LIMIT n limit :: Int -> QueryClauses limit count = QueryClauses $ Endo $ \qc ->   qc { _limit = Just (count, Nothing) } -limitOffset :: Int -> Int -> QueryClauses+-- | LIMIT count, offset+limitOffset ::+  -- | count+  Int ->+  -- | offset+  Int ->+  QueryClauses limitOffset count offset = QueryClauses $ Endo $ \qc ->   qc { _limit = Just (count, Just offset) }  emptyQueryBody :: QueryBody-emptyQueryBody = QueryBody Nothing [] [] [] [] [] Nothing +emptyQueryBody = QueryBody Nothing [] [] [] [] [] Nothing Nothing +-- | SELECT select :: Selector a -> QueryClauses -> Query a select selector (QueryClauses clauses) =   Query selector $ clauses `appEndo` emptyQueryBody +-- | qry1 UNION ALL qry2+unionAll :: Query a -> Query a -> Query a+unionAll = UnionAll++-- | UNION +unionDistinct :: Query a -> Query a -> Query a+unionDistinct = UnionDistinct++-- | Merge a new @Selector@ in a query. mergeSelect :: Query b -> (a -> b -> c) -> Selector a -> Query c mergeSelect (Query selector2 body) f selector1 =   Query (liftA2 f selector1 selector2) body+mergeSelect (UnionAll q1 q2) f s =+  UnionAll (mergeSelect q1 f s) (mergeSelect q2 f s)+mergeSelect (UnionDistinct q1 q2) f s =+  UnionDistinct (mergeSelect q1 f s) (mergeSelect q2 f s) +-- | Replace the @Selector@ from a Query. replaceSelect :: Selector a -> Query b -> Query a replaceSelect s (Query _ body) = Query s body+replaceSelect s (UnionAll q1 q2) =+  UnionAll (replaceSelect s q1) (replaceSelect s q2)+replaceSelect s (UnionDistinct q1 q2) =+  UnionDistinct (replaceSelect s q1) (replaceSelect s q2) +-- | insert values using the given insertor. insertValues :: QueryBuilder -> Insertor a -> [a] -> Command insertValues qb i = InsertValues qb i Nothing +-- | DELETE+delete :: QueryBuilder -> QueryClauses -> Command+delete = Delete++-- | INSERT UPDATE insertUpdateValues :: QueryBuilder                    -> Insertor a                    -> [(QueryBuilder, QueryBuilder)]@@ -672,7 +771,18 @@ -- | Ignore the content of the given columns rawValues_ :: [QueryBuilder] -> Selector () rawValues_ cols = () <$ rawValues cols-  ++forUpdate :: [QueryBuilder] -> WaitLock -> QueryClauses+forUpdate qb wl = QueryClauses $ Endo $ \qc ->+  qc { _lockMode = Just $ ForUpdate qb wl }++forShare :: [QueryBuilder] -> WaitLock -> QueryClauses+forShare qb wl = QueryClauses $ Endo $ \qc ->+  qc { _lockMode = Just $ ForShare qb wl }++shareMode :: QueryClauses+shareMode = QueryClauses $ Endo $ \qc -> qc { _lockMode = Just ShareMode }+ -- selector for any bounded integer type intFromSql :: forall a.(Show a, Bounded a, Integral a)             => MySQLValue -> Either SQLError  a@@ -690,8 +800,10 @@        "Int (" <> show (minBound :: a) <> ", " <> show (maxBound :: a) <> ")"   where castFromInt :: Int64 -> Either SQLError a         castFromInt i-          | i < fromIntegral (minBound :: a) = throwError $ ConversionError "underflow"-          | i > fromIntegral (maxBound :: a) = throwError $ ConversionError "overflow"+          | i < fromIntegral (minBound :: a) =+              throwError $ ConversionError "underflow"+          | i > fromIntegral (maxBound :: a) =+              throwError $ ConversionError "overflow"           | otherwise = pure $ fromIntegral i         castFromWord :: Word64 -> Either SQLError a         castFromWord i@@ -713,7 +825,16 @@   Right i -> pure i integerFromSql v = throwError $ TypeError v "Integer" -+-- | Exclude fields to insert.+insertLess :: Insertor a -> [Text] -> Insertor a+insertLess (Insertor fields t) toRemove =+  Insertor (filterList fields) (filterList . t)+  where+    filterList = mapMaybe removeMaybe . zip removeIt+    removeIt = map (`elem` toRemove) fields+    removeMaybe (True, _) = Nothing+    removeMaybe (False, x) = Just x+     instance FromSql Bool where   fromSql (MySQLInt8U x) = pure $ x /= 0   fromSql (MySQLInt8 x) = pure $ x /= 0@@ -805,7 +926,7 @@  instance FromSql Aeson.Value where   fromSql r = case r of-    MySQLText t -> case Aeson.eitherDecodeStrict $ Text.encodeUtf8 t+    MySQLBytes t -> case Aeson.eitherDecodeStrict t                    of Right val -> Right val                       Left err -> Left $ ConversionError $ Text.pack err     _ -> Left $ TypeError r "Value"@@ -876,4 +997,4 @@   toSqlValue = MySQLInt8U . fromIntegral . fromEnum  instance ToSql Aeson.Value where-  toSqlValue = MySQLText . LazyText.toStrict . Aeson.encodeToLazyText+  toSqlValue = MySQLBytes . LazyBS.toStrict . Aeson.encode
src/Database/MySQL/Hasqlator/Typed.hs view
@@ -13,38 +13,47 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Database.MySQL.Hasqlator.Typed   ( -- * Database Types     Table(..), Field(..), Alias(..), (@@), Nullable (..), JoinType (..),+    quotedTableName, quotedFieldName,          -- * Querying-    Query, untypeQuery, executeQuery,+    QueryClauses, Query, mkQuery, untypeQuery, executeQuery, unionAll,+    unionDistinct,      -- * Selectors-    Selector, sel, selMaybe,+    Selector, sel, selMaybe, forUpdate, forShare, shareMode,      -- * Expressions     Expression, SomeExpression, someExpr, Operator,      arg, argMaybe, isNull, isNotNull, nullable, notNull, orNull, unlessNull,     cast, unsafeCast, op, fun1, fun2, fun3, (=.), (/=.), (>.), (<.), (>=.),-    (<=.), (&&.), (||.), substr, true_, false_, in_, notIn_, +    (<=.), (&&.), (||.), substr, true_, false_, in_, notIn_,+    and_, or_, All_(..), Any_(..), all_, any_,          -- * Clauses     from, fromSubQuery, innerJoin, leftJoin, joinSubQuery, leftJoinSubQuery,-    where_, groupBy_, having, orderBy, limit, limitOffset,+    where_, groupBy_, having, orderBy, QueryOrdering(..), limit, limitOffset,      -- * Insertion     Insertor, insertValues, insertUpdateValues, insertSelect, insertData,     skipInsert, into,     lensInto, maybeLensInto, opticInto, maybeOpticInto, insertOne, exprInto,-    Into,+    Into, insertWithout, updateWithout, +    -- * Deletion+    delete,+     -- * Update     Updator(..), update,      -- * imported from Database.MySQL.Hasqlator-    H.Getter, H.ToSql, H.FromSql, subQueryExpr, H.executeCommand, H.Command+    H.Getter, H.ToSql, H.FromSql, subQueryExpr, H.executeCommand, H.Command,+    H.WaitLock   ) where import Data.Text (Text)@@ -81,6 +90,7 @@     JoinNullable 'LeftJoined _ = 'Nullable  data Field (table :: Symbol) database (nullable :: Nullable) a =+  AllFields |   Field Text Text   newtype Expression (nullable :: Nullable) a =@@ -133,7 +143,11 @@  -- | An table alias that can be used inside the Query.  The function -- inside the newtype can also be applied directly to create an--- expression from a field.+-- expression from a field.  For constructing records, applicativeDo+-- is the recommended way.  However note that this may fail due to a+-- bug in ghc, that breaks the polymorphism.  In that case as a+-- workaround you should use the Alias newtype directly and use the+-- `@@` operator to create an expression instead newtype Alias table database (joinType :: JoinType) =   Alias { getTableAlias ::           forall fieldNull a .@@ -154,9 +168,19 @@  type QueryInner a = State ClauseState a -newtype Query database a = Query (QueryInner a)+newtype QueryClauses database a = QueryClauses (QueryInner a)   deriving (Functor, Applicative, Monad) +data Query database a = Query (QueryClauses database a)+                      | UnionAll (Query database a) (Query database a)+                      | UnionDistinct (Query database a) (Query database a)++unionAll :: Query database a -> Query database a -> Query database a+unionAll = UnionAll++unionDistinct :: Query database a -> Query database a -> Query database a+unionDistinct = UnionDistinct+ type Operator a b c = forall nullable .                       (Expression nullable a ->                        Expression nullable b ->@@ -164,14 +188,22 @@  infixl 9 @@ +mkQuery :: QueryClauses database a -> Query database a+mkQuery = Query+ untypeQuery :: Query database (Selector a) -> H.Query a-untypeQuery (Query query) =+untypeQuery (Query (QueryClauses query)) =   let (selector, clauseState) =-        runState (do (Selector sel) <- query; sel) emptyClauseState+        runState (do (Selector sel_) <- query; sel_) emptyClauseState   in H.select selector $ clausesBuild clauseState+untypeQuery (UnionAll qr1 qr2) =+  H.unionAll (untypeQuery qr1) (untypeQuery qr2)+untypeQuery (UnionDistinct qr1 qr2) =+  H.unionDistinct (untypeQuery qr1) (untypeQuery qr2)  executeQuery :: MySQL.MySQLConn -> Query database (Selector a) -> IO [a]-executeQuery conn query = H.executeQuery conn (untypeQuery query)+executeQuery conn qry = H.executeQuery conn $ untypeQuery qry+    -- | Create an expression from an aliased table and a field. (@@) :: Alias table database (joinType :: JoinType)@@ -181,11 +213,11 @@   mkTableAlias :: Text -> Alias table database leftJoined mkTableAlias tableName = Alias $ \field ->-  Expression $ pure $ H.rawSql $ tableName <> "." <> fieldName field+  Expression $ pure $ H.rawSql $ tableName <> "." <> quotedFieldName field  emptyAlias :: Alias table database leftJoined emptyAlias = Alias $ \field ->-  Expression $ pure $ H.rawSql $ fieldName field+  Expression $ pure $ H.rawSql $ quotedFieldName field  data QueryOrdering = Asc SomeExpression | Desc SomeExpression @@ -253,6 +285,34 @@ (||.) = op (H.||.) (&&.) = op (H.&&.) +newtype All_ nullable = All_ { getAll_ :: Expression nullable Bool }++instance Semigroup (All_ nullable) where+  All_ x <> All_ y = All_ $ x &&.y+instance Monoid (All_ nullable) where+  mempty = All_ true_++and_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool+and_ = getAll_ . foldMap All_++all_ :: Foldable f => (a -> Expression nullable Bool) -> f a+     -> Expression nullable Bool+all_ f = getAll_ . foldMap (All_ . f)++newtype Any_ nullable = Any_ { getAny_ :: Expression nullable Bool }++instance Semigroup (Any_ nullable) where+  Any_ x <> Any_ y = Any_ $ x ||. y+instance Monoid (Any_ nullable) where+  mempty = Any_ false_++or_ :: Foldable f => f (Expression nullable Bool) -> Expression nullable Bool+or_ = getAny_ . foldMap Any_++any_ :: Foldable f => (a -> Expression nullable Bool) -> f a+     -> Expression nullable Bool+any_ f = getAny_ . foldMap (Any_ . f)+          isNull :: Expression nullable a -> Expression 'NotNull Bool isNull (Expression e) = Expression $ H.isNull <$> e @@ -260,8 +320,8 @@ isNotNull (Expression e) = Expression $ H.isNotNull <$> e  true_, false_ :: Expression nullable Bool-true_ = Expression $ pure $ H.false_-false_ = Expression $ pure $ H.true_+true_ = Expression $ pure H.false_+false_ = Expression $ pure H.true_  in_ :: Expression nullable a -> [Expression nullable a]     -> Expression nullable Bool@@ -370,18 +430,19 @@ unsafeCast :: Expression nullable a -> Expression nullable b unsafeCast = coerce -fieldName :: Field table database nullable a -> Text-fieldName (Field _ fn) = fn+quotedFieldName :: Field table database nullable a -> Text+quotedFieldName (Field _ fn) = "`" <> fn <> "`"+quotedFieldName AllFields = "*"  insertOne :: H.ToSql a           => Field table database 'NotNull fieldType           -> Insertor table database a-insertOne = Insertor . H.insertOne . fieldName+insertOne = Insertor . H.insertOne . quotedFieldName  insertOneMaybe :: H.ToSql a                => Field table database 'Nullable fieldType                -> Insertor table database (Maybe a)-insertOneMaybe = Insertor . H.insertOne . fieldName+insertOneMaybe = Insertor . H.insertOne . quotedFieldName  genFst :: (a :*: b) () -> a () genFst (a :*: _) = a@@ -437,40 +498,58 @@ --   into :: (a -> Expression nullable b)-     -> Field table database nullable fieldType+     -> Field table database nullable b      -> Insertor table database a into e f =   Insertor $   H.exprInto (\x -> evalState (runExpression $ e x) emptyClauseState)-  (fieldName f) +  (quotedFieldName f)   lensInto :: H.ToSql b          => H.Getter a b-         -> Field table database 'NotNull fieldType+         -> Field table database 'NotNull b          -> Insertor table database a-lensInto lens a = Insertor $ H.lensInto lens $ fieldName a+lensInto lens a = Insertor $ H.lensInto lens $ quotedFieldName a  maybeLensInto :: H.ToSql b               => H.Getter a (Maybe b)-              -> Field table database 'Nullable fieldType+              -> Field table database 'Nullable b               -> Insertor table database a-maybeLensInto lens a = Insertor $ H.lensInto lens $ fieldName a+maybeLensInto lens a = Insertor $ H.lensInto lens $ quotedFieldName a  opticInto :: (H.ToSql b , Is k A_Getter )           => Optic' k is a b-          -> Field table database 'NotNull fieldType+          -> Field table database 'NotNull b           -> Insertor table database a opticInto getter field = (arg . view getter) `into` field  maybeOpticInto :: (H.ToSql b , Is k A_Getter)                => Optic' k is a (Maybe b)-               -> Field table database 'Nullable fieldType+               -> Field table database 'Nullable b                -> Insertor table database a maybeOpticInto getter field = (argMaybe . view getter) `into` field +insertWithout :: Field tables database nullable b+              -> Insertor table database a+              -> Insertor table database a+insertWithout fld (Insertor ins) = Insertor $ H.insertLess ins [quotedFieldName fld]++updateWithout :: Field table database nullable a -> [Updator table database]+              -> [Updator table database]+updateWithout fld = filter $ \(fld2 := _) -> fld2 `fieldNeq` fld+  where fieldNeq (Field tbl col) (Field tbl2 col2) = (tbl, col) /= (tbl2, col2)+        fieldNeq AllFields AllFields = False+        fieldNeq _ _ = True+    +quotedTableName :: Table table database -> Text+quotedTableName (Table mbSchema tableName) =+  foldMap (\schema -> "`" <> schema <> "`.") mbSchema <>+  "`" <>+  tableName <>+  "`"+   tableSql :: Table table database -> H.QueryBuilder-tableSql (Table mbSchema tableName) =-  H.rawSql $ foldMap (<> ".") mbSchema <> tableName+tableSql tbl = H.rawSql $ quotedTableName tbl  insertValues :: Table table database              -> Insertor table database a@@ -481,7 +560,7 @@  valuesAlias :: Alias table database leftJoined valuesAlias = Alias $ \field ->-  Expression $ pure $ H.values $ H.rawSql $ fieldName field+  Expression $ pure $ H.values $ H.rawSql $ quotedFieldName field  insertUpdateValues :: Table table database                    -> Insertor table database a@@ -497,8 +576,13 @@         runUpdator :: Updator table database                    -> QueryInner (H.QueryBuilder, H.QueryBuilder)           runUpdator (field := Expression expr) = do-          (H.rawSql $ fieldName field, ) <$> expr+          (H.rawSql $ quotedFieldName field, ) <$> expr +delete :: QueryClauses database (Alias table database 'InnerJoined) -> H.Command+delete (QueryClauses qry) = H.delete fields clauseBody+  where (Alias al, ClauseState clauseBody _) = runState qry emptyClauseState+        fields = flip evalState emptyClauseState $ runExpression $ al AllFields+         newAlias :: Text -> QueryInner Text newAlias prefix = do   clsState <- get@@ -511,8 +595,8 @@   clsState { clausesBuild = clausesBuild clsState <> c }  from :: Table table database-     -> Query database (Alias table database 'InnerJoined)-from table@(Table _ tableName) = Query $+     -> QueryClauses database (Alias table database 'InnerJoined)+from table@(Table _ tableName) = QueryClauses $   do alias <- newAlias (Text.take 1 tableName)      addClauses $ H.from $ tableSql table `H.as` H.rawSql alias      pure $ mkTableAlias alias@@ -520,8 +604,8 @@ innerJoin :: Table table database           -> (Alias table database 'InnerJoined ->               Expression nullable Bool)-          -> Query database (Alias table database 'InnerJoined)-innerJoin table@(Table _ tableName) joinCondition = Query $ do+          -> QueryClauses database (Alias table database 'InnerJoined)+innerJoin table@(Table _ tableName) joinCondition = QueryClauses $ do   alias <- newAlias $ Text.take 1 tableName   let tblAlias = mkTableAlias alias   exprBuilder <- runExpression $ joinCondition tblAlias@@ -533,8 +617,8 @@ leftJoin :: Table table database          -> (Alias table database 'LeftJoined ->              Expression nullable Bool)-         -> Query database (Alias table database 'LeftJoined)-leftJoin table@(Table _ tableName) joinCondition = Query $ do+         -> QueryClauses database (Alias table database 'LeftJoined)+leftJoin table@(Table _ tableName) joinCondition = QueryClauses $ do   alias <- newAlias $ Text.take 1 tableName   let tblAlias = mkTableAlias alias   exprBuilder <- runExpression $ joinCondition tblAlias@@ -553,7 +637,7 @@   -- elements.   subJoinGeneric :: Proxy joinType                  -> inExpr-                 -> ReaderT Text (State Int)+                 -> ReaderT Text (State Int)                      (DList.DList SomeExpression, outExpr)  instance ( SubQueryExpr joinType (a ()) (c ())@@ -563,7 +647,7 @@     (lftBuilder, outLft) <- subJoinGeneric p l     (rtBuilder, outRt) <- subJoinGeneric p r     pure (lftBuilder <> rtBuilder, outLft :*: outRt)-          +     instance SubQueryExpr joinType (a ()) (b ()) =>          SubQueryExpr joinType (M1 m1 m2 a ()) (M1 m3 m4 b ()) where   subJoinGeneric p (M1 x) = fmap M1 <$> subJoinGeneric p x@@ -584,28 +668,40 @@        )  -- update the aliases, but create and return new query clauses-runAsSubQuery :: Query database a -> QueryInner (H.QueryClauses, a)-runAsSubQuery (Query sq) =+runAsSubQuery :: QueryClauses database a -> QueryInner (H.QueryClauses, a)+runAsSubQuery (QueryClauses sq) =   do ClauseState currentClauses currentAliases <- get      let (subQueryRet, ClauseState subQueryBody newAliases) =            runState sq (ClauseState mempty currentAliases)      put $ ClauseState currentClauses newAliases      pure (subQueryBody, subQueryRet) +subQuerySelect :: Query database (Expression nullable a)+               -> QueryInner (H.Query ())+subQuerySelect (Query sq) = do+  (subQueryBody, Expression sqSelect) <- runAsSubQuery sq +  selectBuilder <- sqSelect+  pure $ H.select (H.rawValues_ [selectBuilder]) subQueryBody+subQuerySelect (UnionAll sq1 sq2) = do+  q1 <- subQuerySelect sq1+  q2 <- subQuerySelect sq2+  pure $ H.unionAll q1 q2+subQuerySelect (UnionDistinct sq1 sq2) = do+  q1 <- subQuerySelect sq1+  q2 <- subQuerySelect sq2+  pure $ H.unionDistinct q1 q2+   subQueryExpr :: Query database (Expression nullable a) -> Expression nullable a-subQueryExpr sq = Expression $-  do (subQueryBody, Expression subQuerySelect) <- runAsSubQuery sq -     selectBuilder <- subQuerySelect-     pure $ H.subQuery $ H.select (H.rawValues_ [selectBuilder]) subQueryBody+subQueryExpr sqr = Expression $ H.subQuery <$> subQuerySelect sqr --- -subJoinBody :: (Generic inExprs,-              Generic outExprs,-              SubQueryExpr joinType (Rep inExprs ()) (Rep outExprs ()))-            => Proxy joinType-            -> Query database inExprs-            -> QueryInner (H.QueryBuilder, outExprs)-subJoinBody p sq = do+subJoinSelect :: forall inExprs outExprs joinType database.+                 (Generic inExprs,+                  Generic outExprs,+                  SubQueryExpr joinType (Rep inExprs ()) (Rep outExprs ()))+              => Proxy joinType+              -> Query database inExprs+              -> QueryInner (H.Query (), outExprs)+subJoinSelect p (Query sq) = do   sqAlias <- newAlias "sq"   (subQueryBody, sqExprs) <- runAsSubQuery sq   let from' :: Generic inExprs => inExprs -> Rep inExprs ()@@ -618,16 +714,34 @@                                   from' sqExprs       outExpr = to' outExprRep   selectBuilder <- DList.toList <$> traverse runSomeExpression selectExprs-  pure ( H.subQuery $ H.select (H.rawValues_ selectBuilder) subQueryBody+  pure ( H.select (H.rawValues_ selectBuilder) subQueryBody        , outExpr)+subJoinSelect p (UnionAll sq1 sq2) = do+  (sqr1, outExpr) <- subJoinSelect p sq1+  (sqr2, _) <- subJoinSelect @inExprs @outExprs p sq2+  pure (H.unionAll sqr1 sqr2, outExpr)+subJoinSelect p (UnionDistinct sq1 sq2) = do+  (sqr1, outExpr) <- subJoinSelect p sq1+  (sqr2, _) <- subJoinSelect @inExprs @outExprs p sq2+  pure (H.unionDistinct sqr1 sqr2, outExpr) +subJoinBody :: (Generic inExprs,+              Generic outExprs,+              SubQueryExpr joinType (Rep inExprs ()) (Rep outExprs ()))+            => Proxy joinType+            -> Query database inExprs+            -> QueryInner (H.QueryBuilder, outExprs)+subJoinBody p sq = do+  (sqr, outExpr) <- subJoinSelect p sq+  pure (H.subQuery sqr, outExpr)+ joinSubQuery :: (Generic inExprs,                  Generic outExprs,                  SubQueryExpr 'InnerJoined (Rep inExprs ()) (Rep outExprs ()))              => Query database inExprs              -> (outExprs -> Expression nullable Bool)-             -> Query database outExprs-joinSubQuery sq condition = Query $ do+             -> QueryClauses database outExprs+joinSubQuery sq condition = QueryClauses $ do   (subQueryBody, outExpr) <- subJoinBody (Proxy :: Proxy 'InnerJoined) sq   conditionBuilder <- runExpression $ condition outExpr   addClauses $ H.innerJoin [subQueryBody] [conditionBuilder]@@ -638,8 +752,8 @@                      SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ()))                  => Query database inExprs                  -> (outExprs -> Expression nullable Bool)-                 -> Query database outExprs-leftJoinSubQuery sq condition = Query $ do+                 -> QueryClauses database outExprs+leftJoinSubQuery sq condition = QueryClauses $ do   (subQueryBody, outExpr) <- subJoinBody (Proxy :: Proxy 'LeftJoined) sq   conditionBuilder <- runExpression $ condition outExpr   addClauses $ H.leftJoin [subQueryBody] [conditionBuilder]@@ -649,40 +763,51 @@                  Generic outExprs,                  SubQueryExpr 'LeftJoined (Rep inExprs ()) (Rep outExprs ()))              => Query database inExprs-             -> Query database outExprs-fromSubQuery sq = Query $ do              +             -> QueryClauses database outExprs+fromSubQuery sq = QueryClauses $ do                 (subQueryBody, outExpr) <- subJoinBody (Proxy :: Proxy 'LeftJoined) sq    addClauses $ H.from subQueryBody   pure outExpr -where_ :: Expression 'NotNull Bool -> Query database ()-where_ expr = Query $ do+where_ :: Expression 'NotNull Bool -> QueryClauses database ()+where_ expr = QueryClauses $ do   exprBuilder <- runExpression expr   addClauses $ H.where_ [exprBuilder] -groupBy_ :: [SomeExpression] -> Query database ()-groupBy_ columns = Query $ do+groupBy_ :: [SomeExpression] -> QueryClauses database ()+groupBy_ columns = QueryClauses $ do   columnBuilders <- traverse runSomeExpression columns   addClauses $ H.groupBy_ columnBuilders -having :: Expression nullable Bool -> Query database ()-having expr = Query $ do+having :: Expression nullable Bool -> QueryClauses database ()+having expr = QueryClauses $ do   exprBuilder <- runExpression expr   addClauses $ H.having [exprBuilder] -orderBy :: [QueryOrdering] -> Query database ()-orderBy ordering = Query $+orderBy :: [QueryOrdering] -> QueryClauses database ()+orderBy ordering = QueryClauses $   do newOrdering <- traverse orderingToH ordering      addClauses $ H.orderBy newOrdering   where orderingToH (Asc x) = H.Asc <$> runSomeExpression x         orderingToH (Desc x) = H.Desc <$> runSomeExpression x -limit :: Int -> Query database ()-limit count = Query $ addClauses $ H.limit count+limit :: Int -> QueryClauses database ()+limit count = QueryClauses $ addClauses $ H.limit count -limitOffset :: Int -> Int -> Query database ()-limitOffset count offset = Query $ addClauses $ H.limitOffset count offset+limitOffset :: Int -> Int -> QueryClauses database ()+limitOffset count offset = QueryClauses $ addClauses $ H.limitOffset count offset +forUpdate :: [Table table database] -> H.WaitLock -> QueryClauses database ()+forUpdate tables waitLock = QueryClauses $ do+  addClauses $ H.forUpdate (map (H.rawSql . quotedTableName) tables) waitLock++forShare :: [Table table database] -> H.WaitLock -> QueryClauses database ()+forShare tables waitLock = QueryClauses $ do+  addClauses $ H.forShare (map (H.rawSql . quotedTableName) tables) waitLock++shareMode :: QueryClauses database ()+shareMode = QueryClauses $ addClauses H.shareMode+ newtype Into database (table :: Symbol) =   Into { runInto :: QueryInner (Text, H.QueryBuilder) } @@ -690,17 +815,17 @@             Field table database nullable a ->             Into database table exprInto expr field =-  Into $ (fieldName field,) <$> runExpression expr+  Into $ (quotedFieldName field,) <$> runExpression expr  insertSelect :: Table table database-             -> Query database [Into database table]+             -> QueryClauses database [Into database table]              -> H.Command-insertSelect table (Query query) =+insertSelect table (QueryClauses qry) =   H.insertSelect (tableSql table)   (map (H.rawSql . fst) intos)   (map snd intos) clauses   where (intos, ClauseState clauses _) =-          runState (query >>= traverse runInto) emptyClauseState+          runState (qry >>= traverse runInto) emptyClauseState  infix 0 := @@ -710,18 +835,17 @@  update :: Table table database        -> (Alias table database 'InnerJoined ->-           Query database [Updator table database])+           QueryClauses database [Updator table database])        -> H.Command-update table query =-  H.update [tableSql table]-  updators clauses-  where Query runQuery = query emptyAlias+update table qry =+  H.update [tableSql table] updators clauses+  where QueryClauses runQuery = qry emptyAlias         (updators, ClauseState clauses _) =           runState (runQuery >>= traverse runUpdator) emptyClauseState         runUpdator :: Updator table database                    -> QueryInner (H.QueryBuilder, H.QueryBuilder)           runUpdator (field := Expression expr) = do-          (H.rawSql $ fieldName field, ) <$> expr+          (H.rawSql $ quotedFieldName field, ) <$> expr