relational-query 0.12.1.0 → 0.12.2.0

raw patch · 29 files changed

+504/−325 lines, 29 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• relational-query.cabal +19/−7
• src/Database/Relational.hs +18/−1
• src/Database/Relational/Arrow.hs +16/−17
• src/Database/Relational/Derives.hs +2/−2
• src/Database/Relational/Effect.hs +116/−61
• src/Database/Relational/Internal/Config.hs +13/−2
• src/Database/Relational/Internal/Literal.hs +50/−0
• src/Database/Relational/Internal/String.hs +1/−13
• src/Database/Relational/Monad/Assign.hs +1/−6
• src/Database/Relational/Monad/Restrict.hs +1/−7
• src/Database/Relational/Monad/Trans/Assigning.hs +2/−2
• src/Database/Relational/Monad/Trans/Join.hs +7/−4
• src/Database/Relational/Monad/Trans/Qualify.hs +2/−2
• src/Database/Relational/NonStandard/PureTimestampTZ.hs +24/−0
• src/Database/Relational/Pi.hs +6/−2
• src/Database/Relational/Pi/Unsafe.hs +17/−6
• src/Database/Relational/Pure.hs +25/−69
• src/Database/Relational/PureUTF8.hs +36/−0
• src/Database/Relational/Sequence.hs +1/−2
• src/Database/Relational/SimpleSql.hs +2/−3
• src/Database/Relational/SqlSyntax/Fold.hs +17/−10
• src/Database/Relational/SqlSyntax/Join.hs +3/−3
• src/Database/Relational/SqlSyntax/Types.hs +1/−3
• src/Database/Relational/TH.hs +3/−3
• src/Database/Relational/Table.hs +8/−2
• src/Database/Relational/Type.hs +84/−76
• test/sqlsEq.hs +19/−19
• test/sqlsEqArrow.hs +3/−3

@@ -1,5 +1,12 @@ <!-- -*- Markdown -*- --> +## 0.12.2.0++- add configuration flags to fix problem of correlation.+- not import LiteralSQL instance for UTF-8 encoded ByteString by default.+- not import LiteralSQL instance for ZonedTime and UTCTime corresponding TIMESTAMPTZ by default.+- deprecations of some old APIs.+ ## 0.12.1.0  - add LiteralSQL instances of word and integer types.

@@ -1,10 +1,12 @@ name:                relational-query-version:             0.12.1.0+version:             0.12.2.0 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can                      translate into SQL query.+                     .                      Supported query features are below:+                     .                      - Type safe query building                      - Restriction, Join, Aggregation                      - Modularized relations@@ -14,11 +16,12 @@ license-file:        LICENSE author:              Kei Hibino maintainer:          ex8k.hibino@gmail.com-copyright:           Copyright (c) 2013-2018 Kei Hibino+copyright:           Copyright (c) 2013-2019 Kei Hibino category:            Database build-type:          Simple cabal-version:       >=1.10-tested-with:           GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3+tested-with:           GHC == 8.6.1, GHC == 8.6.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5+                     , GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3, GHC == 8.4.4                      , GHC == 8.2.1, GHC == 8.2.2                      , GHC == 8.0.1, GHC == 8.0.2                      , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3@@ -35,6 +38,8 @@                        Database.Relational.Table                        Database.Relational.SimpleSql                        Database.Relational.Pure+                       Database.Relational.PureUTF8+                       Database.Relational.NonStandard.PureTimestampTZ                        Database.Relational.Pi                        Database.Relational.Pi.Unsafe                        Database.Relational.Constraint@@ -80,6 +85,7 @@                        Database.Relational.Internal.Config                        Database.Relational.Internal.String                        Database.Relational.Internal.UntypedTable+                       Database.Relational.Internal.Literal                        Database.Relational.SqlSyntax.Types                        Database.Relational.SqlSyntax.Join                        Database.Relational.SqlSyntax.Aggregate@@ -109,12 +115,14 @@                        , names-th                        , persistable-record >= 0.6   if impl(ghc == 7.4.*)-    build-depends:        ghc-prim == 0.2.*+    build-depends:       ghc-prim == 0.2.*    hs-source-dirs:      src   ghc-options:         -Wall -fsimpl-tick-factor=200+  if impl(ghc >= 8)+    ghc-options:         -Wcompat -Wnoncanonical-monadfail-instances -  default-language:     Haskell2010+  default-language:    Haskell2010  test-suite sqls   build-depends:         base <5@@ -134,8 +142,10 @@    hs-source-dirs:      test   ghc-options:         -Wall -fsimpl-tick-factor=200+  if impl(ghc >= 8)+    ghc-options:         -Wcompat -Wnoncanonical-monadfail-instances -  default-language:     Haskell2010+  default-language:    Haskell2010  test-suite sqlsArrow   build-depends:         base <5@@ -155,8 +165,10 @@    hs-source-dirs:      test   ghc-options:         -Wall+  if impl(ghc >= 8)+    ghc-options:         -Wcompat -Wnoncanonical-monadfail-instances -  default-language:     Haskell2010+  default-language:    Haskell2010   source-repository head

@@ -68,7 +68,8 @@    MonadQuery, query', queryMaybe',    MonadPartition, partitionBy,    distinct, all', on)-import Database.Relational.Monad.Trans.Ordering (orderBy', orderBy, asc, desc)+import Database.Relational.Monad.Trans.Ordering+  (Orderings, orderBy', orderBy, asc, desc) import Database.Relational.Monad.Trans.Aggregating   (key, key', set, bkey, rollup, cube, groupingSets) import Database.Relational.Monad.Trans.Assigning (assignTo, (<-#))@@ -88,6 +89,22 @@   (unsafeTypedKeyUpdate, unsafeTypedDelete,    unsafeTypedInsert, unsafeTypedInsertQuery, ) import Database.Relational.Effect+  (Restriction, restriction, restriction',++   UpdateTarget, updateTarget',+   liftTargetAllColumn, liftTargetAllColumn',++   InsertTarget, insertTarget', piRegister,++   sqlChunkFromInsertTarget,+   sqlFromInsertTarget,+   sqlChunksFromRecordList,++   insertTarget, updateTarget,+   updateTargetAllColumn, updateTargetAllColumn',+   sqlWhereFromRestriction,+   sqlFromUpdateTarget,+  ) import Database.Relational.Derives  import Database.Record.Instances ()

@@ -3,7 +3,7 @@  -- | -- Module      : Database.Relational.Arrow--- Copyright   : 2015-2018 Kei Hibino+-- Copyright   : 2015-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -86,10 +86,9 @@    updateAllColumn', updateAllColumn, updateAllColumnNoPH,    insertValue', insertValue, insertValueNoPH, derivedInsertValue', derivedInsertValue,    delete', delete, deleteNoPH, derivedDelete', derivedDelete,-   QuerySimple, QueryAggregate, QueryUnique, Window, Register)+   QuerySimple, QueryAggregate, QueryUnique, Orderings, Window, Register) import qualified Database.Relational as Monadic import qualified Database.Relational.Monad.Trans.Aggregating as Monadic-import qualified Database.Relational.Monad.Trans.Ordering as Monadic import qualified Database.Relational.Monad.Trans.Assigning as Monadic  @@ -133,7 +132,7 @@ type Assignings r m = QueryA (Monadic.Assignings r m)  -- | Arrow type corresponding to 'Monadic.AssignStatement'-type AssignStatement r a = Assignings r Restrict (Record Flat r) a+type AssignStatement r a = QueryA (Monadic.Assignings r Restrict) (Record Flat r) a  -- | Arrow type corresponding to 'Monadic.Register' type Register r a = QueryA (Monadic.Register r) () a@@ -425,38 +424,38 @@  -- | Same as 'Monadic.update''. --   Make 'Update' from assigning statement arrow using configuration.-update' :: TableDerivable r => Config -> AssignStatement r (PlaceHolders p) -> Update p+update' :: TableDerivable r => Config -> QueryA (Monadic.Assignings r Restrict) (Record Flat r) (PlaceHolders p) -> Update p update' config = Monadic.update' config . runQueryA  -- | Same as 'Monadic.update'. --   Make 'Update' from assigning statement arrow.-update :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p+update :: TableDerivable r => QueryA (Monadic.Assignings r Restrict) (Record Flat r) (PlaceHolders p) -> Update p update = Monadic.update . runQueryA  -- | Same as 'Monadic.updateNoPH'. --   Make 'Update' from assigning statement arrow.-updateNoPH :: TableDerivable r => AssignStatement r () -> Update ()+updateNoPH :: TableDerivable r => QueryA (Monadic.Assignings r Restrict) (Record Flat r) () -> Update () updateNoPH = Monadic.updateNoPH . runQueryA  -- | Same as 'Monadic.updateAllColumn''. --   Make 'Update' from restrected statement arrow. updateAllColumn' :: (PersistableWidth r, TableDerivable r)                  => Config-                 -> RestrictedStatement r (PlaceHolders p)+                 -> QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p)                  -> Update (r, p) updateAllColumn' config = Monadic.updateAllColumn' config . runQueryA  -- | Same as 'Monadic.updateAllColumn'. --   Make 'Update' from restrected statement arrow. updateAllColumn :: (PersistableWidth r, TableDerivable r)-                => RestrictedStatement r (PlaceHolders p)+                => QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p)                 -> Update (r, p) updateAllColumn = Monadic.updateAllColumn . runQueryA  -- | Same as 'Monadic.updateAllColumnNoPH'. --   Make 'Update' from restrected statement arrow. updateAllColumnNoPH :: (PersistableWidth r, TableDerivable r)-                    => RestrictedStatement r ()+                    => QueryA Monadic.Restrict (Record Flat r) ()                     -> Update r updateAllColumnNoPH = Monadic.updateAllColumnNoPH . runQueryA @@ -478,28 +477,28 @@  -- | Same as 'Monadic.delete''. --   Make 'Update' from restrict statement arrow using configuration.-delete' :: TableDerivable r => Config -> RestrictedStatement r (PlaceHolders p) -> Delete p+delete' :: TableDerivable r => Config -> QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p) -> Delete p delete' config = Monadic.delete' config . runQueryA  -- | Same as 'Monadic.delete'. --   Make 'Update' from restrict statement arrow.-delete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p+delete :: TableDerivable r => QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p) -> Delete p delete = Monadic.delete . runQueryA  -- | Same as 'Monadic.deleteNoPH'. --   Make 'Update' from restrict statement arrow.-deleteNoPH :: TableDerivable r => RestrictedStatement r () -> Delete ()+deleteNoPH :: TableDerivable r => QueryA Monadic.Restrict (Record Flat r) () -> Delete () deleteNoPH = Monadic.deleteNoPH . runQueryA  {-# DEPRECATED derivedUpdate' "use `update'` instead of this." #-} -- | Same as 'Monadic.update''. --   Make 'Update' from assigning statement arrow using configuration.-derivedUpdate' :: TableDerivable r => Config -> AssignStatement r (PlaceHolders p) -> Update p+derivedUpdate' :: TableDerivable r => Config -> QueryA (Monadic.Assignings r Restrict) (Record Flat r) (PlaceHolders p) -> Update p derivedUpdate' = update'  {-# DEPRECATED derivedUpdate "use `update` instead of this." #-} -- | Deprecated.-derivedUpdate :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p+derivedUpdate :: TableDerivable r => QueryA (Monadic.Assignings r Restrict) (Record Flat r) (PlaceHolders p) -> Update p derivedUpdate = update  {-# DEPRECATED derivedInsertValue' "use `insertValue'` instead of this." #-}@@ -514,10 +513,10 @@  {-# DEPRECATED derivedDelete' "use `derivedDelete'` instead of this." #-} -- | Deprecated.-derivedDelete' :: TableDerivable r => Config -> RestrictedStatement r (PlaceHolders p) -> Delete p+derivedDelete' :: TableDerivable r => Config -> QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p) -> Delete p derivedDelete' = delete'  {-# DEPRECATED derivedDelete "use `derivedDelete` instead of this." #-} -- | Deprecated.-derivedDelete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p+derivedDelete :: TableDerivable r => QueryA Monadic.Restrict (Record Flat r) (PlaceHolders p) -> Delete p derivedDelete = delete

@@ -37,7 +37,7 @@ import Database.Relational.SqlSyntax (Record)  import Database.Relational.Table (Table, TableDerivable)-import Database.Relational.Pi.Unsafe (Pi, unsafeExpandIndexes)+import Database.Relational.Pi (Pi, expandIndexes) import qualified Database.Relational.Record as Record import Database.Relational.Projectable (placeholder, (.=.), (!)) import Database.Relational.Monad.Class (wheres)@@ -106,7 +106,7 @@                     => Pi r p                     -> r                     -> [q]-updateValuesWithKey =  unsafeUpdateValuesWithIndexes . unsafeExpandIndexes+updateValuesWithKey =  unsafeUpdateValuesWithIndexes . expandIndexes  -- | Typed 'KeyUpdate' using specified constraint key. updateByConstraintKey :: Table r       -- ^ 'Table' to update

@@ -1,6 +1,10 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+ -- | -- Module      : Database.Relational.Effect--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -11,24 +15,34 @@ -- like update and delete. module Database.Relational.Effect (   -- * Object to express simple restriction.-  Restriction, restriction, restriction',+  Restriction,    -- * Object to express update target columns and restriction.-  UpdateTarget, updateTarget, updateTarget',-  liftTargetAllColumn, liftTargetAllColumn',-  updateTargetAllColumn, updateTargetAllColumn',+  UpdateTarget,+  liftTargetAllColumn',    -- * Object to express insert terget.-  InsertTarget, insertTarget, insertTarget', piRegister,+  InsertTarget, insertTarget', piRegister,    -- * Generate SQL from restriction.-  sqlWhereFromRestriction,-  sqlFromUpdateTarget,+  deleteFromRestriction,+  updateFromUpdateTarget,   sqlChunkFromInsertTarget,   sqlFromInsertTarget,   sqlChunksFromRecordList,++  -- * Deprecated+  restriction, restriction',+  updateTarget, updateTarget',+  liftTargetAllColumn,+  updateTargetAllColumn, updateTargetAllColumn',+  insertTarget,+  sqlWhereFromRestriction,+  sqlFromUpdateTarget,   ) where +import Control.Applicative ((<$>))+import Control.Monad (void) import Data.Monoid ((<>)) import Data.List (unfoldr) import Data.Functor.ProductIsomorphic (peRight)@@ -36,10 +50,14 @@ import Language.SQL.Keyword (Keyword(..)) import Database.Record.Persistable (PersistableWidth) -import Database.Relational.Internal.Config (Config (chunksInsertSize), defaultConfig)+import Database.Relational.Internal.Config+  (Config (chunksInsertSize, addModifyTableAliasAS), defaultConfig)+import Database.Relational.Internal.ContextType (Flat) import Database.Relational.Internal.String (StringSQL, stringSQL, showStringSQL) import Database.Relational.SqlSyntax-  (composeWhere, composeSets, composeChunkValuesWithColumns, composeValuesListWithColumns)+  (Record, composeWhere, composeSets,+   composeChunkValuesWithColumns, composeValuesListWithColumns,+   Qualified, SubQuery, corrSubQueryTerm)  import Database.Relational.Pi (Pi, id') import qualified Database.Relational.Pi.Unsafe as Pi@@ -49,95 +67,131 @@ import Database.Relational.ProjectableClass (LiteralSQL) import Database.Relational.Projectable   (PlaceHolders, unitPH, pwPlaceholder, placeholder, (><), value, )+import Database.Relational.Monad.BaseType (ConfigureQuery, qualifyQuery, askConfig)+import Database.Relational.Monad.Class (MonadQualify (..)) import Database.Relational.Monad.Trans.Assigning (assignings, (<-#))-import Database.Relational.Monad.Restrict (RestrictedStatement)+import Database.Relational.Monad.Restrict (Restrict) import qualified Database.Relational.Monad.Restrict as Restrict-import Database.Relational.Monad.Assign (AssignStatement)+import Database.Relational.Monad.Assign (Assign) import qualified Database.Relational.Monad.Assign as Assign import Database.Relational.Monad.Register (Register) import qualified Database.Relational.Monad.Register as Register  +-- helper function for UPDATE and DELETE+withQualified :: MonadQualify ConfigureQuery m => Table r -> (Record c r -> m a) -> m StringSQL+withQualified tbl q = do+  let qualTandR :: MonadQualify ConfigureQuery m => Table r -> m (Qualified SubQuery, Record c r)+      qualTandR tbl_ = liftQualify $ do+        qq <- qualifyQuery $ Table.toSubQuery tbl_+        return (qq, Record.unsafeFromQualifiedSubQuery qq {- qualified record expression -})+  (qq, r) <- qualTandR tbl+  void $ q r -- placeholder info is not used+  addAS <- addModifyTableAliasAS <$> liftQualify askConfig+  return $ corrSubQueryTerm addAS qq {- qualified table -}+ -- | Restriction type with place-holder parameter 'p' and projected record type 'r'.-newtype Restriction p r = Restriction (RestrictedStatement r (PlaceHolders p))+type Restriction p r = Record Flat r -> Restrict (PlaceHolders p) --- | Finalize 'Restrict' monad and generate 'Restriction'.-restriction :: RestrictedStatement r () -> Restriction () r-restriction = Restriction . ((>> return unitPH) .)+-- | Deprecated.+restriction :: (Record Flat r -> Restrict ()) -> Restriction () r+restriction = ((>> return unitPH) .)+{-# DEPRECATED restriction "same as ((>> return unitPH) .)" #-} --- | Finalize 'Restrict' monad and generate 'Restriction' with place-holder parameter 'p'-restriction' :: RestrictedStatement r (PlaceHolders p) -> Restriction p r-restriction' = Restriction+-- | Deprecated.+restriction' :: (Record Flat r -> Restrict (PlaceHolders p)) -> Restriction p r+restriction' = id+{-# DEPRECATED restriction' "same as id" #-} -runRestriction :: Restriction p r-               -> RestrictedStatement r (PlaceHolders p)-runRestriction (Restriction qf) = qf+fromRestriction :: Config -> Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> (StringSQL, StringSQL)+fromRestriction config tbl q = (qt, composeWhere rs)+  where (qt, rs) = Restrict.extract (withQualified tbl q) config --- | SQL WHERE clause 'StringSQL' string from 'Restriction'.-sqlWhereFromRestriction :: Config -> Table r -> Restriction p r -> StringSQL-sqlWhereFromRestriction config tbl (Restriction q) = composeWhere rs-  where (_ph, rs) = Restrict.extract (q $ Record.unsafeFromTable tbl) config+-- | SQL WHERE clause 'StringSQL' string from 'Restrict' computation.+sqlWhereFromRestriction :: Config -> Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> StringSQL+sqlWhereFromRestriction config tbl = snd . fromRestriction config tbl+{-# DEPRECATED sqlWhereFromRestriction "low-level API, this API will be expired." #-} --- | Show where clause.-instance TableDerivable r => Show (Restriction p r) where-  show = showStringSQL . sqlWhereFromRestriction defaultConfig derivedTable+-- | DELETE statement with WHERE clause 'StringSQL' string from 'Restrict' computation.+deleteFromRestriction :: Config -> Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> StringSQL+deleteFromRestriction config tbl r =+  DELETE <> FROM <> uncurry (<>) (fromRestriction config tbl r) +-- | Show WHERE clause.+instance TableDerivable r => Show (Record Flat r -> Restrict (PlaceHolders p)) where+  show = showStringSQL . snd . fromRestriction defaultConfig derivedTable + -- | UpdateTarget type with place-holder parameter 'p' and projected record type 'r'.-newtype UpdateTarget p r = UpdateTarget (AssignStatement r (PlaceHolders p))+type UpdateTarget p r = Record Flat r -> Assign r (PlaceHolders p) --- | Finalize 'Target' monad and generate 'UpdateTarget'.-updateTarget :: AssignStatement r ()+-- | Deprecated.+updateTarget :: (Record Flat r -> Assign r ())              -> UpdateTarget () r-updateTarget =  UpdateTarget . ((>> return unitPH) .)+updateTarget =  ((>> return unitPH) .)+{-# DEPRECATED updateTarget "old-style API. Use new-style Database.Relational.updateNoPH." #-} --- | Finalize 'Target' monad and generate 'UpdateTarget' with place-holder parameter 'p'.-updateTarget' :: AssignStatement r (PlaceHolders p)+-- | Deprecated.+updateTarget' :: (Record Flat r -> Assign r (PlaceHolders p))               -> UpdateTarget p r-updateTarget' = UpdateTarget+updateTarget' = id+{-# DEPRECATED updateTarget' "same as id" #-}  updateAllColumn :: PersistableWidth r-                => Restriction p r-                -> AssignStatement r (PlaceHolders (r, p))+                => (Record Flat r -> Restrict (PlaceHolders p))+                -> (Record Flat r -> Assign r (PlaceHolders (r, p))) updateAllColumn rs proj = do   (ph0, ()) <- placeholder (\ph -> id' <-# ph)-  ph1       <- assignings $ runRestriction rs proj+  ph1       <- assignings $ rs proj   return $ ph0 >< ph1 --- | Lift 'Restriction' to 'UpdateTarget'. Update target columns are all.+-- | Lift 'Restrict' computation to 'Assign' computation. Assign target columns are all. liftTargetAllColumn :: PersistableWidth r-                     => Restriction () r-                     -> UpdateTarget r r-liftTargetAllColumn rs = updateTarget' $ \proj -> fmap peRight $ updateAllColumn rs proj+                     => (Record Flat r -> Restrict (PlaceHolders ()))+                     -> (Record Flat r -> Assign r (PlaceHolders r))+liftTargetAllColumn rs = \proj -> fmap peRight $ updateAllColumn rs proj+{-# DEPRECATED liftTargetAllColumn "old-style API. use Database.Relational.updateAllColumnNoPH instead of this." #-} --- | Lift 'Restriction' to 'UpdateTarget'. Update target columns are all. With placefolder type 'p'.+-- | Lift 'Restrict' computation to 'Assign' computation. Assign target columns are all. With placefolder type 'p'. liftTargetAllColumn' :: PersistableWidth r-                     => Restriction p r-                     -> UpdateTarget (r, p) r-liftTargetAllColumn' rs = updateTarget' $ updateAllColumn rs+                     => (Record Flat r -> Restrict (PlaceHolders p))+                     -> (Record Flat r -> Assign r (PlaceHolders (r, p)))+liftTargetAllColumn' rs = updateAllColumn rs --- | Finalize 'Restrict' monad and generate 'UpdateTarget'. Update target columns are all.+-- | Deprecated. updateTargetAllColumn :: PersistableWidth r-                      => RestrictedStatement r ()-                      -> UpdateTarget r r+                      => (Record Flat r -> Restrict ())+                      -> (Record Flat r -> Assign r (PlaceHolders r)) updateTargetAllColumn = liftTargetAllColumn . restriction+{-# DEPRECATED updateTargetAllColumn "Use Database.Relational.updateAllColumnNoPH instead of this." #-} --- | Finalize 'Restrict' monad and generate 'UpdateTarget'. Update target columns are all. With placefolder type 'p'.+-- | Deprecated. updateTargetAllColumn' :: PersistableWidth r-                       => RestrictedStatement r (PlaceHolders p)-                       -> UpdateTarget (r, p) r-updateTargetAllColumn' = liftTargetAllColumn' . restriction'+                       => (Record Flat r -> Restrict (PlaceHolders p))+                       -> (Record Flat r -> Assign r (PlaceHolders (r, p)))+updateTargetAllColumn' = liftTargetAllColumn'+{-# DEPRECATED updateTargetAllColumn' "Use Database.Relational.updateAllColumn instead of this." #-}  --- | SQL SET clause and WHERE clause 'StringSQL' string from 'UpdateTarget'-sqlFromUpdateTarget :: Config -> Table r -> UpdateTarget p r -> StringSQL-sqlFromUpdateTarget config tbl (UpdateTarget q) = composeSets (asR tbl) <> composeWhere rs-  where ((_ph, asR), rs) = Assign.extract (q (Record.unsafeFromTable tbl)) config+fromUpdateTarget :: Config -> Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> (StringSQL, StringSQL)+fromUpdateTarget config tbl q = (qt, composeSets (asR tbl) <> composeWhere rs)+  where ((qt, asR), rs) = Assign.extract (withQualified tbl q) config -instance TableDerivable r => Show (UpdateTarget p r) where-  show = showStringSQL . sqlFromUpdateTarget defaultConfig derivedTable+-- | SQL SET clause and WHERE clause 'StringSQL' string from 'Assign' computation.+sqlFromUpdateTarget :: Config -> Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> StringSQL+sqlFromUpdateTarget config tbl = snd . fromUpdateTarget config tbl+{-# DEPRECATED sqlFromUpdateTarget "low-level API, this API will be expired." #-} +-- | UPDATE statement with SET clause and WHERE clause 'StringSQL' string from 'Assign' computation.+updateFromUpdateTarget :: Config -> Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> StringSQL+updateFromUpdateTarget config tbl ut =+  UPDATE <> uncurry (<>) (fromUpdateTarget config tbl ut) +-- | Show Set clause and WHERE clause.+instance TableDerivable r => Show (Record Flat r -> Assign r (PlaceHolders p)) where+  show = showStringSQL . snd . fromUpdateTarget defaultConfig derivedTable++ -- | InsertTarget type with place-holder parameter 'p' and projected record type 'r'. newtype InsertTarget p r = InsertTarget (Register r (PlaceHolders p)) @@ -145,8 +199,9 @@ insertTarget :: Register r ()              -> InsertTarget () r insertTarget =  InsertTarget . (>> return unitPH)+{-# DEPRECATED insertTarget "old-style API. Use new-style Database.Relational.insertValueNoPH ." #-} --- | Finalize 'Target' monad and generate 'UpdateTarget' with place-holder parameter 'p'.+-- | Finalize 'Register' monad and generate 'InsertTarget' with place-holder parameter 'p'. insertTarget' :: Register r (PlaceHolders p)               -> InsertTarget p r insertTarget' = InsertTarget

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Internal.Config--- Copyright   : 2017-2018 Kei Hibino+-- Copyright   : 2017-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -20,6 +20,8 @@   chunksInsertSize,   schemaNameMode,   normalizedTableName,+  addQueryTableAliasAS,+  addModifyTableAliasAS,   enableWarning,   verboseAsCompilerWarning,   disableOverloadedProjection,@@ -88,6 +90,10 @@   -- ^ 'SchemaNameMode' configuration   , normalizedTableName          ::  !Bool   -- ^ If True, schema names become uppercase, and table names become lowercase.+  , addQueryTableAliasAS         ::  !Bool+  -- ^ If True, AS keyword is not skipped but added in table-alias of SELECT statement or correlate SELECT clause.+  , addModifyTableAliasAS        ::  !Bool+  -- ^ If True, AS keyword is not skipped but added in target-table-alias of UPDATE and DELETE statement.   , enableWarning                ::  !Bool   -- ^ If True, print warning messages in macros of relational-record.   , verboseAsCompilerWarning     ::  !Bool@@ -112,6 +118,9 @@ --     , chunksInsertSize              =  256 --     , schemaNameMode                =  'SchemaQualified' --     , normalizedTableName           =  True+--     , addQueryTableAliasAS          =  False+--     , addModifyTableAliasAS         =  False+--     , enableWarning                 =  True --     , verboseAsCompilerWarning      =  False --     , disableOverloadedProjection   =  False --     , disableSpecializedProjection  =  False@@ -130,7 +139,9 @@          , chunksInsertSize              =  256          , schemaNameMode                =  SchemaQualified          , normalizedTableName           =  True-         , enableWarning                   =  True+         , addQueryTableAliasAS          =  False+         , addModifyTableAliasAS         =  False+         , enableWarning                 =  True          , verboseAsCompilerWarning      =  False          , disableOverloadedProjection   =  False          , disableSpecializedProjection  =  False

@@ -0,0 +1,50 @@+-- |+-- Module      : Database.Relational.Internal.Literal+-- Copyright   : 2019 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides definitions to lift haskell expressions+-- into SQL expressions.+module Database.Relational.Internal.Literal (+  stringExpr,+  bool, integral, timestamp,+  ) where++import Data.Monoid ((<>))+import Data.Time (FormatTime, formatTime)+import Data.Time.Locale.Compat (defaultTimeLocale)++import Language.SQL.Keyword (Keyword)++import Database.Relational.Internal.String (StringSQL, stringSQL)+++-- | Escape 'String' for constant SQL string expression.+escapeStringToSqlExpr :: String -> String+escapeStringToSqlExpr = rec where+  rec ""        = ""+  rec ('\'':cs) = '\'' : '\'' : rec cs+  rec (c:cs)    = c : rec cs++-- | From 'String' into constant SQL string expression.+stringExpr :: String -> StringSQL+stringExpr = stringSQL . ('\'' :) . (++ "'") . escapeStringToSqlExpr++-- | SQL expressions for Bool type.+bool :: Bool -> StringSQL+bool =+    stringSQL . d+  where+    d True  = "(0=0)"+    d False = "(0=1)"++-- | Constant integral SQL term.+integral :: (Show a, Integral a) => a -> StringSQL+integral = stringSQL . show++timestamp :: FormatTime t => Keyword -> String -> t -> StringSQL+timestamp kw fmt t = kw <> stringExpr (formatTime defaultTimeLocale fmt t)

@@ -1,8 +1,6 @@-{-# LANGUAGE FlexibleInstances #-}- -- | -- Module      : Database.Relational.Internal.String--- Copyright   : 2014-2017 Kei Hibino+-- Copyright   : 2014-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -16,8 +14,6 @@   rowStringSQL, rowPlaceHolderStringSQL,    rowConsStringSQL, listStringSQL,--  boolSQL,   ) where  import Language.SQL.Keyword (Keyword, word, wordShow, fold, (|*|), paren)@@ -52,11 +48,3 @@ -- | List String of SQL. listStringSQL :: [StringSQL] -> StringSQL listStringSQL =  paren . fold (|*|)---- | SQL expressions for Bool type.-boolSQL :: Bool -> StringSQL-boolSQL =-    stringSQL . d-  where-    d True  = "(0=0)"-    d False = "(0=1)"

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Monad.Assign--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,7 +15,6 @@ module Database.Relational.Monad.Assign (   -- * Monad to restrict target records with assignment.   Assign, AssignStatement,-  -- updateStatement,   extract,   ) where @@ -38,10 +37,6 @@ --   Record type must be --   the same as 'Target' type parameter 'r'. type AssignStatement r a = Record Flat r -> Assign r a---- -- | 'return' of 'Update'--- updateStatement :: a -> Assignings r (Restrictings Identity) a--- updateStatement =  assignings . restrictings . Identity  -- | Run 'Assign'. extract :: Assign r a -> Config -> ((a, Table r -> [Assignment]), [Predicate Flat])

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Monad.Restrict--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,8 +15,6 @@ module Database.Relational.Monad.Restrict (   -- * Monad to restrict target records.   Restrict, RestrictedStatement,--  -- restricted,   extract   ) where @@ -36,10 +34,6 @@ --   Record type 'r' must be --   the same as 'Restrictings' type parameter 'r'. type RestrictedStatement r a = Record Flat r -> Restrict a---- -- | 'return' of 'Restrict'--- restricted :: a -> Restrict a--- restricted =  restrict . Identity  -- | Run 'Restrict' to get 'QueryRestriction'. extract :: Restrict a -> Config -> (a, [Predicate Flat])

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Monad.Trans.Assigning--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -77,7 +77,7 @@  infix 4 <-# --- | Run 'Assignings' to get 'Assignments'+-- | Run 'Assignings' to get ['Assignment'] extractAssignments :: (Monad m, Functor m)                    => Assignings r m a                    -> m (a, Table r -> [Assignment])

@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Monad.Trans.Join--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -34,15 +34,17 @@ import Data.Monoid (Last (Last, getLast))  import Database.Relational.Internal.ContextType (Flat)+import Database.Relational.Internal.Config (addQueryTableAliasAS) import Database.Relational.SqlSyntax   (Duplication (All), NodeAttr (Just', Maybe), Predicate, Record,    SubQuery, Qualified, JoinProduct, restrictProduct, growProduct, ) +import Database.Relational.Monad.Class (liftQualify) import Database.Relational.Monad.Trans.JoinState   (JoinContext, primeJoinContext, updateProduct, joinProduct) import qualified Database.Relational.Record as Record import Database.Relational.Projectable (PlaceHolders, unsafeAddPlaceHolders)-import Database.Relational.Monad.BaseType (ConfigureQuery, qualifyQuery, Relation, untypeRelation)+import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig, qualifyQuery, Relation, untypeRelation) import Database.Relational.Monad.Class (MonadQualify (..), MonadQuery (..))  @@ -81,12 +83,13 @@     return (ph, Record.just pj)  -- | Unsafely join sub-query with this query.-unsafeSubQueryWithAttr :: Monad q+unsafeSubQueryWithAttr :: MonadQualify ConfigureQuery q                        => NodeAttr                 -- ^ Attribute maybe or just                        -> Qualified SubQuery       -- ^ 'SubQuery' to join                        -> QueryJoin q (Record c r) -- ^ Result joined context and record of 'SubQuery' result. unsafeSubQueryWithAttr attr qsub = do-  updateContext (updateProduct (`growProduct` (attr, qsub)))+  addAS <- addQueryTableAliasAS <$> liftQualify askConfig+  updateContext (updateProduct (`growProduct` (attr, (addAS, qsub))))   return $ Record.unsafeFromQualifiedSubQuery qsub  -- | Basic monadic join operation using 'MonadQuery'.

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Monad.Trans.Qualify--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -48,7 +48,7 @@  -- | Get qualifyed table form query. qualifyQuery :: Monad m-             => query                                -- ^ Query to qualify+             => query                              -- ^ Query to qualify              -> Qualify m (Syntax.Qualified query) -- ^ Result with updated state qualifyQuery query =   Syntax.qualify `liftM` newAlias `ap` return query

@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}++module Database.Relational.NonStandard.PureTimestampTZ () where++import Control.Applicative (pure)+import Data.Time (UTCTime, ZonedTime)++import Language.SQL.Keyword (Keyword (..))++import qualified Database.Relational.Internal.Literal as Lit++import Database.Relational.ProjectableClass (LiteralSQL (..))+++-- | Constant SQL terms of 'ZonedTime'.+--   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal.+instance LiteralSQL ZonedTime where+  showLiteral' = pure . Lit.timestamp TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z"++-- | Constant SQL terms of 'UTCTime'.+--   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal with UTC timezone.+instance LiteralSQL UTCTime where+  showLiteral' = pure . Lit.timestamp TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z"

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Pi--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -14,11 +14,15 @@   Pi, (<.>), (<?.>), (<?.?>),    id',++  -- * Low-level API+  expandIndexes', expandIndexes,   ) where  import qualified Control.Category as Category -import Database.Relational.Pi.Unsafe (Pi, (<.>), (<?.>), (<?.?>))+import Database.Relational.Pi.Unsafe+  (Pi, (<.>), (<?.>), (<?.?>), expandIndexes', expandIndexes)   -- | Identity projection path.

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Pi.Unsafe--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -25,6 +25,9 @@    definePi, defineDirectPi', defineDirectPi, +  expandIndexes', expandIndexes,++  -- * Deprecated   unsafeExpandIndexes',   unsafeExpandIndexes   ) where@@ -68,16 +71,24 @@       (pbc, wc) = g $ wbf wb   in (pab `unsafePiAppend'` pbc, wcf wc) --- | Unsafely expand indexes from key.-unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]-unsafeExpandIndexes' wa (Pi f) = d $ f wa where+-- | Expand indexes from key.+expandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]+expandIndexes' wa (Pi f) = d $ f wa where   d (Map is, _)    = is   d (Leftest i, w) = [ i .. i + w' - 1 ]  where     w' = runPersistableRecordWidth w --- | Unsafely expand indexes from key. Infered width version.+unsafeExpandIndexes' :: PersistableRecordWidth a -> Pi a b -> [Int]+unsafeExpandIndexes' = expandIndexes'+{-# DEPRECATED unsafeExpandIndexes' "Use expandIndexes' instead of this." #-}++-- | Expand indexes from key. Infered width version.+expandIndexes :: PersistableWidth a => Pi a b -> [Int]+expandIndexes = expandIndexes' persistableWidth+ unsafeExpandIndexes :: PersistableWidth a => Pi a b -> [Int]-unsafeExpandIndexes = unsafeExpandIndexes' persistableWidth+unsafeExpandIndexes = expandIndexes+{-# DEPRECATED unsafeExpandIndexes "use expandIndexes instead of this." #-}  -- | Unsafely cast width proof object of record. Result record must be same width. unsafeCastRecordWidth :: PersistableRecordWidth a -> PersistableRecordWidth a'

@@ -3,31 +3,25 @@  -- | -- Module      : Database.Relational.Pure--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com -- Stability   : experimental -- Portability : unknown ----- This module defines interfaces between haskell pure values--- and query internal record values.+-- This module defines instances which lift from haskell pure values+-- to query internal record values. module Database.Relational.Pure () where  import Control.Applicative (pure)-import Data.Monoid ((<>)) import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64, Word)-import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as LB import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LT import Text.Printf (PrintfArg, printf)-import Data.Time (FormatTime, Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, formatTime)-import Data.Time.Locale.Compat (defaultTimeLocale)+import Data.Time (Day, TimeOfDay, LocalTime) import Data.DList (DList, fromList)  import Language.SQL.Keyword (Keyword (..))@@ -36,104 +30,79 @@ import Database.Record.Persistable   (runPersistableRecordWidth) -import Database.Relational.Internal.String (StringSQL, stringSQL, boolSQL)+import Database.Relational.Internal.String (StringSQL, stringSQL)+import qualified Database.Relational.Internal.Literal as Lit  import Database.Relational.ProjectableClass (LiteralSQL (..))  --- | Constant integral SQL terms.-intTermsSQL :: (Show a, Integral a) => a -> DList StringSQL-intTermsSQL =  pure . stringSQL . show---- | Escape 'String' for constant SQL string expression.-escapeStringToSqlExpr :: String -> String-escapeStringToSqlExpr =  rec  where-  rec ""        = ""-  rec ('\'':cs) = '\'' : '\'' : rec cs-  rec (c:cs)    = c : rec cs---- | From 'String' into constant SQL string expression.-stringExprSQL :: String -> StringSQL-stringExprSQL =  stringSQL . ('\'':) . (++ "'") . escapeStringToSqlExpr--stringTermsSQL :: String -> DList StringSQL-stringTermsSQL = pure . stringExprSQL- -- | Constant SQL terms of '()'. instance LiteralSQL ()  -- | Constant SQL terms of 'Int8'. instance LiteralSQL Int8 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Int16'. instance LiteralSQL Int16 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Int32'. instance LiteralSQL Int32 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Int64'. instance LiteralSQL Int64 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Int'. --   Use this carefully, because this is architecture dependent size of integer type. instance LiteralSQL Int where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Word8'. instance LiteralSQL Word8 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Word16'. instance LiteralSQL Word16 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Word32'. instance LiteralSQL Word32 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Word64'. instance LiteralSQL Word64 where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'Word'. --   Use this carefully, because this is architecture dependent size of integer type. instance LiteralSQL Word where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  instance LiteralSQL Integer where-  showLiteral' = intTermsSQL+  showLiteral' = pure . Lit.integral  -- | Constant SQL terms of 'String'. instance LiteralSQL String where-  showLiteral' = stringTermsSQL---- | Constant SQL terms of 'ByteString'.-instance LiteralSQL ByteString where-  showLiteral' = stringTermsSQL . T.unpack . T.decodeUtf8---- | Constant SQL terms of 'LB.ByteString'.-instance LiteralSQL LB.ByteString where-  showLiteral' = stringTermsSQL . LT.unpack . LT.decodeUtf8+  showLiteral' = pure . Lit.stringExpr  -- | Constant SQL terms of 'Text'. instance LiteralSQL Text where-  showLiteral' = stringTermsSQL . T.unpack+  showLiteral' = pure . Lit.stringExpr . T.unpack  -- | Constant SQL terms of 'LT.Text'. instance LiteralSQL LT.Text where-  showLiteral' = stringTermsSQL . LT.unpack+  showLiteral' = pure . Lit.stringExpr . LT.unpack  -- | Constant SQL terms of 'Char'. instance LiteralSQL Char where-  showLiteral' = stringTermsSQL . (:"")+  showLiteral' = pure . Lit.stringExpr . (:"")  -- | Constant SQL terms of 'Bool'. instance LiteralSQL Bool where-  showLiteral' = pure . boolSQL+  showLiteral' = pure . Lit.bool  floatTerms :: (PrintfArg a, Ord a, Num a)=> a -> DList StringSQL floatTerms f = pure . stringSQL $ printf fmt f  where@@ -149,30 +118,17 @@ instance LiteralSQL Double where   showLiteral' = floatTerms -constantTimeTerms :: FormatTime t => Keyword -> String -> t -> DList StringSQL-constantTimeTerms kw fmt t = pure $ kw <> stringExprSQL (formatTime defaultTimeLocale fmt t)- -- | Constant SQL terms of 'Day'. instance LiteralSQL Day where-  showLiteral' = constantTimeTerms DATE "%Y-%m-%d"+  showLiteral' = pure . Lit.timestamp DATE "%Y-%m-%d"  -- | Constant SQL terms of 'TimeOfDay'. instance LiteralSQL TimeOfDay where-  showLiteral' = constantTimeTerms TIME "%H:%M:%S"+  showLiteral' = pure . Lit.timestamp TIME "%H:%M:%S"  -- | Constant SQL terms of 'LocalTime'. instance LiteralSQL LocalTime where-  showLiteral' = constantTimeTerms TIMESTAMP "%Y-%m-%d %H:%M:%S"---- | Constant SQL terms of 'ZonedTime'.---   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal.-instance LiteralSQL ZonedTime where-  showLiteral' = constantTimeTerms TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z"---- | Constant SQL terms of 'UTCTime'.---   This generates ***NOT STANDARD*** SQL of TIMESTAMPTZ literal with UTC timezone.-instance LiteralSQL UTCTime where-  showLiteral' = constantTimeTerms TIMESTAMPTZ "%Y-%m-%d %H:%M:%S%z"+  showLiteral' = pure . Lit.timestamp TIMESTAMP "%Y-%m-%d %H:%M:%S"  showMaybeTerms :: LiteralSQL a => PersistableRecordWidth a -> Maybe a -> DList StringSQL showMaybeTerms wa = d  where

@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Database.Relational.PureUTF8+-- Copyright   : 2013-2019 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines instances to lift from haskell UTF8 byte-sequence+-- to query internal record values.+-- This module is not defaultly imported to be selectable instance of byte-sequences.+module Database.Relational.PureUTF8 () where++import Control.Applicative (pure)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT++import qualified Database.Relational.Internal.Literal as Lit++import Database.Relational.ProjectableClass (LiteralSQL (..))+++-- | Constant SQL terms of 'ByteString'.+instance LiteralSQL ByteString where+  showLiteral' = pure . Lit.stringExpr . T.unpack . T.decodeUtf8++-- | Constant SQL terms of 'LB.ByteString'.+instance LiteralSQL LB.ByteString where+  showLiteral' = pure . Lit.stringExpr . LT.unpack . LT.decodeUtf8

@@ -45,7 +45,6 @@ import Database.Relational.ProjectableClass (LiteralSQL) import Database.Relational.Relation (tableOf) import qualified Database.Relational.Relation as Relation-import Database.Relational.Effect (updateTarget') import Database.Relational.Type (Update, typedUpdate')  @@ -140,7 +139,7 @@               -> i            -- ^ sequence number to set. expect not SQL injectable.               -> Sequence s i -- ^ sequence table               -> Update ()-updateNumber' config i seqt = typedUpdate' config (seqTable seqt) . updateTarget' $ \ proj -> do+updateNumber' config i seqt = typedUpdate' config (seqTable seqt) $ \ proj -> do   let iv = value i   seqKey seqt <-# iv   wheres $ proj ! seqKey seqt .<=. iv -- fool proof

@@ -35,8 +35,7 @@ import Database.Relational.Internal.String   (StringSQL, stringSQL, showStringSQL, rowConsStringSQL, ) -import Database.Relational.Pi (Pi)-import qualified Database.Relational.Pi.Unsafe as UnsafePi+import Database.Relational.Pi (Pi, expandIndexes') import Database.Relational.Table (Table, name, columns, recordWidth) import qualified Database.Relational.Record as Record @@ -88,7 +87,7 @@           -> Pi r p  -- ^ Key columns           -> String  -- ^ Result SQL updateOtherThanKeySQL tbl key =-  updateOtherThanKeySQL' (name tbl) (columns tbl) (UnsafePi.unsafeExpandIndexes' (recordWidth tbl) key)+  updateOtherThanKeySQL' (name tbl) (columns tbl) (expandIndexes' (recordWidth tbl) key)  -- | Generate prefix string of insert SQL. insertPrefixSQL :: Pi r r' -> Table r -> StringSQL

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.SqlSyntax.Fold--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,7 +15,7 @@   showSQL, toSQL, unitSQL, width,    -- * Qualified Sub-query-  queryWidth,+  queryWidth, corrSubQueryTerm,    -- * Sub-query columns   column,@@ -48,7 +48,8 @@ import Database.Relational.Internal.UntypedTable ((!)) import qualified Database.Relational.Internal.UntypedTable as UntypedTable import Database.Relational.Internal.String-  (StringSQL, stringSQL, rowStringSQL, showStringSQL, boolSQL, )+  (StringSQL, stringSQL, rowStringSQL, showStringSQL, )+import qualified Database.Relational.Internal.Literal as Lit import Database.Relational.SqlSyntax.Types   (SubQuery (..), Record, Tuple, Predicate,    Column (..), CaseClause(..), WhenClauses (..),@@ -94,11 +95,6 @@ columnFromId :: Qualifier -> Int -> StringSQL columnFromId qi i = qi <.> columnN i --- | From 'Qualified' SQL string into qualified formed 'String'---  like (SELECT ...) AS T<n>-qualifiedSQLas :: Qualified StringSQL -> StringSQL-qualifiedSQLas q = Syntax.unQualify q <> showQualifier (Syntax.qualifier q)- -- | Width of 'SubQuery'. width :: SubQuery -> Int width =  d  where@@ -176,6 +172,17 @@ toSQL :: SubQuery -> String toSQL =  showStringSQL . showSQL +-- | Term of qualified table or qualified subquery,+--   used in join-clause of SELECT, correlated UPDATE and DELETE statements.+--   When SubQuery is table, expression will be like <TABLE> [AS] T<n>+corrSubQueryTerm :: Bool                -- ^ if True, add AS keyword. SQLite causes syntax error on UPDATE or DELETE statement.+                 -> Qualified SubQuery  -- ^ subquery structure with qualifier+                 -> StringSQL           -- ^ result SQL string+corrSubQueryTerm addAS qq =+    showUnitSQL (Syntax.unQualify qq) `asOP` showQualifier (Syntax.qualifier qq)+  where+    asOP = if addAS then SQL.as else (<>)+ -- | Get column SQL string of 'Qualified' 'SubQuery'. column :: Qualified SubQuery -> Int -> StringSQL column qs =  d (Syntax.unQualify qs)  where@@ -244,13 +251,13 @@   urec n = case Syntax.nodeTree n of     p@(Leaf _)     -> rec p     p@(Join {})    -> SQL.paren (rec p)-  rec (Leaf q)               = qualifiedSQLas $ fmap showUnitSQL q+  rec (Leaf q)               = uncurry corrSubQueryTerm q   rec (Join left' right' rs) =     mconcat     [urec left',      joinType (Syntax.nodeAttr left') (Syntax.nodeAttr right'), JOIN,      urec right',-     ON, foldr1 SQL.and $ ps ++ concat [ pure $ boolSQL True | null ps ] ]+     ON, foldr1 SQL.and $ ps ++ concat [ pure $ Lit.bool True | null ps ] ]     where ps = [ rowStringSQL $ recordRawColumns p | p <- rs ]  -- | Shows join product of query.

@@ -33,9 +33,9 @@   d (Just l) (naR, q) = Node Just' $ Join l (Node naR q) mempty  -- | Push new leaf node into product right term.-growProduct :: Maybe (Node (DList (Predicate Flat))) -- ^ Current tree-            -> (NodeAttr, Qualified SubQuery)       -- ^ New leaf to push into right-            -> Node (DList (Predicate Flat))         -- ^ Result node+growProduct :: Maybe (Node (DList (Predicate Flat)))  -- ^ Current tree+            -> (NodeAttr, (Bool, Qualified SubQuery)) -- ^ New leaf to push into right+            -> Node (DList (Predicate Flat))          -- ^ Result node growProduct =  match  where   match t (na, q) =  growRight t (na, Leaf q) 

@@ -133,11 +133,9 @@ -- | node attribute for product. data NodeAttr = Just' | Maybe deriving Show -type QS = Qualified SubQuery- -- | Product tree type. Product tree is constructed by left node and right node. data ProductTree rs-  = Leaf QS+  = Leaf (Bool, Qualified SubQuery)   | Join !(Node rs) !(Node rs) !rs   deriving (Show, Functor) 

@@ -7,7 +7,7 @@  -- | -- Module      : Database.Relational.TH--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -90,7 +90,7 @@    NameConfig (..), SchemaNameMode (..), IdentifierQuotation (..), defaultConfig,    Config (normalizedTableName, disableOverloadedProjection, disableSpecializedProjection,            schemaNameMode, nameConfig, identifierQuotation),-   relationalQuerySQL, Query, relationalQuery, KeyUpdate,+   Query, untypeQuery, relationalQuery_, relationalQuery, KeyUpdate,    Insert, insert, InsertQuery, insertQuery,    HasConstraintKey(constraintKey), Primary, NotNull, primarySelect, primaryUpdate) @@ -455,7 +455,7 @@ inlineQuery relVar rel config sufs qns = do   (p, r) <- reifyRelation relVar   unsafeInlineQuery (return p) (return r)-    (relationalQuerySQL config rel sufs)+    (untypeQuery $ relationalQuery_ config rel sufs)     (varCamelcaseName qns)  -- | Generate all templates against defined record like type constructor

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Table--- Copyright   : 2013-2017 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -24,13 +24,19 @@   (PersistableWidth, PersistableRecordWidth, unsafePersistableRecordWidth)  import Database.Relational.Internal.UntypedTable (Untyped (Untyped), name', width', columns', (!))-import Database.Relational.Internal.String (StringSQL, stringSQL, )+import Database.Relational.Internal.String (StringSQL, stringSQL, showStringSQL) import Database.Relational.SqlSyntax (SubQuery) import qualified Database.Relational.SqlSyntax as Syntax   -- | Phantom typed table type newtype Table r = Table Untyped++instance Show (Table r) where+  show t =+    unwords+    ["Table",  show $ name t,+     show . map showStringSQL $ columns t]  -- | Untype table. untype :: Table t -> Untyped

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Type--- Copyright   : 2013-2018 Kei Hibino+-- Copyright   : 2013-2019 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -12,6 +12,7 @@   -- * Typed query statement   Query (..), unsafeTypedQuery, +  relationalQuery_,   relationalQuery', relationalQuery,    relationalQuerySQL,@@ -28,7 +29,8 @@   unsafeTypedInsert', unsafeTypedInsert, typedInsert', insert,   typedInsertValue', insertValue', insertValue, insertValueNoPH,   insertValueList', insertValueList,-  InsertQuery (..), unsafeTypedInsertQuery, typedInsertQuery', insertQuery,+  InsertQuery (..), unsafeTypedInsertQuery,+  typedInsertQuery', insertQuery', insertQuery,    insertQuerySQL, @@ -41,6 +43,7 @@   UntypeableNoFetch (..),    -- * Deprecated+   typedUpdate,   typedInsert, typedInsertValue, typedInsertQuery,   typedDelete,@@ -56,32 +59,31 @@   derivedDelete', derivedDelete,   ) where -import Control.Applicative ((<*)) import Data.Monoid ((<>))+import Data.Functor.ProductIsomorphic (peRight)  import Database.Record (PersistableWidth)  import Database.Relational.Internal.Config (Config, defaultConfig)+import Database.Relational.Internal.ContextType (Flat) import Database.Relational.Internal.String (showStringSQL)+import Database.Relational.SqlSyntax (Record)  import Database.Relational.Monad.BaseType (Relation, sqlFromRelationWith)-import Database.Relational.Monad.Restrict (RestrictedStatement)-import Database.Relational.Monad.Assign (AssignStatement)+import Database.Relational.Monad.Restrict (Restrict)+import Database.Relational.Monad.Assign (Assign) import Database.Relational.Monad.Register (Register) import Database.Relational.Relation (tableOf) import Database.Relational.Effect-  (Restriction, restriction, restriction', UpdateTarget, updateTarget',-   liftTargetAllColumn, liftTargetAllColumn',-   InsertTarget, insertTarget',-   sqlWhereFromRestriction, sqlFromUpdateTarget, piRegister,+  (liftTargetAllColumn', InsertTarget, insertTarget',+   deleteFromRestriction, updateFromUpdateTarget, piRegister,    sqlChunkFromInsertTarget, sqlFromInsertTarget, sqlChunksFromRecordList) import Database.Relational.Pi (Pi) import Database.Relational.Table (Table, TableDerivable, derivedTable) import Database.Relational.ProjectableClass (LiteralSQL) import Database.Relational.Projectable (PlaceHolders, unitPH) import Database.Relational.SimpleSql-  (QuerySuffix, showsQuerySuffix, insertPrefixSQL,-   updateOtherThanKeySQL, updatePrefixSQL, deletePrefixSQL)+  (QuerySuffix, showsQuerySuffix, insertPrefixSQL, updateOtherThanKeySQL, )   -- | Query type with place-holder parameter 'p' and query result type 'a'.@@ -98,11 +100,17 @@  -- | From 'Relation' into untyped SQL query string. relationalQuerySQL :: Config -> Relation p r -> QuerySuffix -> String-relationalQuerySQL config rel qsuf = showStringSQL $ sqlFromRelationWith rel config <> showsQuerySuffix qsuf+relationalQuerySQL config rel qsuf =+  showStringSQL $ sqlFromRelationWith rel config <> showsQuerySuffix qsuf  -- | From 'Relation' into typed 'Query' with suffix SQL words.+relationalQuery_ :: Config -> Relation p r -> QuerySuffix -> Query p r+relationalQuery_ config rel qsuf =+  unsafeTypedQuery $ relationalQuerySQL config rel qsuf++-- | From 'Relation' into typed 'Query' with suffix SQL words. relationalQuery' :: Relation p r -> QuerySuffix -> Query p r-relationalQuery' rel qsuf = unsafeTypedQuery $ relationalQuerySQL defaultConfig rel qsuf+relationalQuery' = relationalQuery_ defaultConfig  -- | From 'Relation' into typed 'Query'. relationalQuery :: Relation p r -> Query p r@@ -152,101 +160,98 @@ unsafeTypedUpdate :: String -> Update p unsafeTypedUpdate =  Update --- | Make untyped update SQL string from 'Table' and 'UpdateTarget'.-updateSQL :: Config -> Table r -> UpdateTarget p r -> String-updateSQL config tbl ut = showStringSQL $ updatePrefixSQL tbl <> sqlFromUpdateTarget config tbl ut+-- | Make untyped update SQL string from 'Table' and 'Assign' computation.+updateSQL :: Config -> Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> String+updateSQL config tbl ut = showStringSQL $ updateFromUpdateTarget config tbl ut --- | Make typed 'Update' from 'Config', 'Table' and 'UpdateTarget'.-typedUpdate' :: Config -> Table r -> UpdateTarget p r -> Update p+-- | Make typed 'Update' from 'Config', 'Table' and 'Assign' computation.+typedUpdate' :: Config -> Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> Update p typedUpdate' config tbl ut = unsafeTypedUpdate $ updateSQL config tbl ut  {-# DEPRECATED typedUpdate "use `typedUpdate' defaultConfig` instead of this." #-}--- | Make typed 'Update' using 'defaultConfig', 'Table' and 'UpdateTarget'.-typedUpdate :: Table r -> UpdateTarget p r -> Update p+-- | Make typed 'Update' using 'defaultConfig', 'Table' and 'Assign' computation.+typedUpdate :: Table r -> (Record Flat r -> Assign r (PlaceHolders p)) -> Update p typedUpdate =  typedUpdate' defaultConfig -targetTable :: TableDerivable r => UpdateTarget p r -> Table r+targetTable :: TableDerivable r => (Record Flat r -> Assign r (PlaceHolders p)) -> Table r targetTable =  const derivedTable --- | Make typed 'Update' from 'Config', derived table and 'AssignStatement'-update' :: TableDerivable r => Config -> AssignStatement r (PlaceHolders p) -> Update p-update' config utc =  typedUpdate' config (targetTable ut) ut  where-  ut = updateTarget' utc+-- | Make typed 'Update' from 'Config', derived table and 'Assign' computation.+update' :: TableDerivable r => Config -> (Record Flat r -> Assign r (PlaceHolders p)) -> Update p+update' config ac =  typedUpdate' config (targetTable ac) ac  {-# DEPRECATED derivedUpdate' "use `update'` instead of this." #-}--- | Make typed 'Update' from 'Config', derived table and 'AssignStatement'-derivedUpdate' :: TableDerivable r => Config -> AssignStatement r (PlaceHolders p) -> Update p+-- | Make typed 'Update' from 'Config', derived table and 'Assign' computation.+derivedUpdate' :: TableDerivable r => Config -> (Record Flat r -> Assign r (PlaceHolders p)) -> Update p derivedUpdate' = update' --- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement'-update :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p+-- | Make typed 'Update' from 'defaultConfig', derived table and 'Assign' computation.+update :: TableDerivable r => (Record Flat r -> Assign r (PlaceHolders p)) -> Update p update = update' defaultConfig --- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement' with no(unit) placeholder.-updateNoPH :: TableDerivable r => AssignStatement r () -> Update ()-updateNoPH af = update $ (return unitPH <*) . af+-- | Make typed 'Update' from 'defaultConfig', derived table and 'Assign' computation with no(unit) placeholder.+updateNoPH :: TableDerivable r => (Record Flat r -> Assign r ()) -> Update ()+updateNoPH af = update $ (>> return unitPH) . af  {-# DEPRECATED derivedUpdate "use `update` instead of this." #-}--- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement'-derivedUpdate :: TableDerivable r => AssignStatement r (PlaceHolders p) -> Update p+-- | Make typed 'Update' from 'defaultConfig', derived table and 'Assign' computation.+derivedUpdate :: TableDerivable r => (Record Flat r -> Assign r (PlaceHolders p)) -> Update p derivedUpdate = update  --- | Make typed 'Update' from 'Config', 'Table' and 'Restriction'.+-- | Make typed 'Update' from 'Config', 'Table' and 'Restrict' computation. --   Update target is all column. typedUpdateAllColumn' :: PersistableWidth r                       => Config                       -> Table r-                      -> Restriction p r+                      -> (Record Flat r -> Restrict (PlaceHolders p))                       -> Update (r, p) typedUpdateAllColumn' config tbl r = typedUpdate' config tbl $ liftTargetAllColumn' r --- | Make typed 'Update' from 'Table' and 'Restriction'.+-- | Make typed 'Update' from 'Table' and 'Restrict' computation. --   Update target is all column. typedUpdateAllColumn :: PersistableWidth r                      => Table r-                     -> Restriction p r+                     -> (Record Flat r -> Restrict (PlaceHolders p))                      -> Update (r, p) typedUpdateAllColumn = typedUpdateAllColumn' defaultConfig --- | Make typed 'Update' from 'Config', derived table and 'AssignStatement'.+-- | Make typed 'Update' from 'Config', derived table and 'Restrict' computation. --   Update target is all column. updateAllColumn' :: (PersistableWidth r, TableDerivable r)                  => Config-                 -> RestrictedStatement r (PlaceHolders p)+                 -> (Record Flat r -> Restrict (PlaceHolders p))                  -> Update (r, p)-updateAllColumn' config = typedUpdateAllColumn' config derivedTable .restriction'+updateAllColumn' config = typedUpdateAllColumn' config derivedTable  {-# DEPRECATED derivedUpdateAllColumn' "use `updateAllColumn'` instead of this." #-}--- | Make typed 'Update' from 'Config', derived table and 'AssignStatement'.---   Update target is all column.+-- | Deprecated. use 'updateAllColumn''. derivedUpdateAllColumn' :: (PersistableWidth r, TableDerivable r)                         => Config-                        -> RestrictedStatement r (PlaceHolders p)+                        -> (Record Flat r -> Restrict (PlaceHolders p))                         -> Update (r, p) derivedUpdateAllColumn' = updateAllColumn' --- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement'.+-- | Make typed 'Update' from 'defaultConfig', derived table and 'Restrict' computation. --   Update target is all column. updateAllColumn :: (PersistableWidth r, TableDerivable r)-                       => RestrictedStatement r (PlaceHolders p)-                       -> Update (r, p)+                => (Record Flat r -> Restrict (PlaceHolders p))+                -> Update (r, p) updateAllColumn = updateAllColumn' defaultConfig --- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement'+-- | Make typed 'Update' from 'defaultConfig', derived table and 'Restrict' computation --   without placeholder other than target table columns. --   Update target is all column. updateAllColumnNoPH :: (PersistableWidth r, TableDerivable r)-                    => RestrictedStatement r ()+                    => (Record Flat r -> Restrict ())                     -> Update r updateAllColumnNoPH =-  typedUpdate' defaultConfig derivedTable . liftTargetAllColumn . restriction+  typedUpdate' defaultConfig derivedTable . (fmap peRight .) . liftTargetAllColumn' . ((>> return unitPH) .)  {-# DEPRECATED derivedUpdateAllColumn "use `updateAllColumn` instead of this." #-}--- | Make typed 'Update' from 'defaultConfig', derived table and 'AssignStatement'.---   Update target is all column.+-- | Deprecated. use 'updateAllColumn'. derivedUpdateAllColumn :: (PersistableWidth r, TableDerivable r)-                       => RestrictedStatement r (PlaceHolders p)+                       => (Record Flat r -> Restrict (PlaceHolders p))                        -> Update (r, p) derivedUpdateAllColumn = updateAllColumn @@ -329,7 +334,7 @@  -- | Make typed 'Insert' from 'defaultConfig', derived table and monadic builded 'Register' object with no(unit) placeholder. insertValueNoPH :: TableDerivable r => Register r () -> Insert ()-insertValueNoPH = insertValue . (return unitPH <*)+insertValueNoPH = insertValue . (>> return unitPH)  {-# DEPRECATED derivedInsertValue "use `insertValue` instead of this." #-} -- | Make typed 'Insert' from 'defaultConfig', derived table and monadic builded 'Register' object.@@ -378,8 +383,12 @@ typedInsertQuery =  typedInsertQuery' defaultConfig  -- | Table type inferred 'InsertQuery'.+insertQuery' :: TableDerivable r => Config -> Pi r r' -> Relation p r' -> InsertQuery p+insertQuery' config = typedInsertQuery' config derivedTable++-- | Table type inferred 'InsertQuery' with 'defaultConfig'. insertQuery :: TableDerivable r => Pi r r' -> Relation p r' -> InsertQuery p-insertQuery =  typedInsertQuery' defaultConfig derivedTable+insertQuery = insertQuery' defaultConfig  {-# DEPRECATED derivedInsertQuery "use `insertQuery` instead of this." #-} -- | Table type inferred 'InsertQuery'.@@ -398,43 +407,42 @@ unsafeTypedDelete :: String -> Delete p unsafeTypedDelete =  Delete --- | Make untyped delete SQL string from 'Table' and 'Restriction'.-deleteSQL :: Config -> Table r -> Restriction p r -> String-deleteSQL config tbl r = showStringSQL $ deletePrefixSQL tbl <> sqlWhereFromRestriction config tbl r+-- | Make untyped delete SQL string from 'Table' and 'Restrict' computation.+deleteSQL :: Config -> Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> String+deleteSQL config tbl r = showStringSQL $ deleteFromRestriction config tbl r --- | Make typed 'Delete' from 'Config', 'Table' and 'Restriction'.-typedDelete' :: Config -> Table r -> Restriction p r -> Delete p+-- | Make typed 'Delete' from 'Config', 'Table' and 'Restrict' computation.+typedDelete' :: Config -> Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p typedDelete' config tbl r = unsafeTypedDelete $ deleteSQL config tbl r  {-# DEPRECATED typedDelete "use `typedDelete' defaultConfig` instead of this." #-}--- | Make typed 'Delete' from 'Table' and 'Restriction'.-typedDelete :: Table r -> Restriction p r -> Delete p+-- | Make typed 'Delete' from 'Table' and 'Restrict' computation.+typedDelete :: Table r -> (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p typedDelete =  typedDelete' defaultConfig -restrictedTable :: TableDerivable r => Restriction p r -> Table r+restrictedTable :: TableDerivable r => (Record Flat r -> Restrict (PlaceHolders p)) -> Table r restrictedTable =  const derivedTable --- | Make typed 'Delete' from 'Config', derived table and 'RestrictContext'-delete' :: TableDerivable r => Config -> RestrictedStatement r (PlaceHolders p) -> Delete p-delete' config rc = typedDelete' config (restrictedTable rs) rs  where-  rs = restriction' rc+-- | Make typed 'Delete' from 'Config', derived table and 'Restrict' computation.+delete' :: TableDerivable r => Config -> (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p+delete' config rc = typedDelete' config (restrictedTable rc) rc  {-# DEPRECATED derivedDelete' "use `delete'` instead of this." #-}--- | Make typed 'Delete' from 'Config', derived table and 'RestrictContext'-derivedDelete' :: TableDerivable r => Config -> RestrictedStatement r (PlaceHolders p) -> Delete p+-- | Make typed 'Delete' from 'Config', derived table and 'Restrict' computation.+derivedDelete' :: TableDerivable r => Config -> (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p derivedDelete' = delete' --- | Make typed 'Delete' from 'defaultConfig', derived table and 'RestrictContext'-delete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p+-- | Make typed 'Delete' from 'defaultConfig', derived table and 'Restrict' computation.+delete :: TableDerivable r => (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p delete = delete' defaultConfig --- | Make typed 'Delete' from 'defaultConfig', derived table and 'RestrictContext' with no(unit) placeholder.-deleteNoPH :: TableDerivable r => RestrictedStatement r () -> Delete ()-deleteNoPH rf = delete $ (return unitPH <*) . rf+-- | Make typed 'Delete' from 'defaultConfig', derived table and 'Restrict' computation with no(unit) placeholder.+deleteNoPH :: TableDerivable r => (Record Flat r -> Restrict ()) -> Delete ()+deleteNoPH rf = delete $ (>> return unitPH) . rf  {-# DEPRECATED derivedDelete "use `delete` instead of this." #-}--- | Make typed 'Delete' from 'defaultConfig', derived table and 'RestrictContext'-derivedDelete :: TableDerivable r => RestrictedStatement r (PlaceHolders p) -> Delete p+-- | Make typed 'Delete' from 'defaultConfig', derived table and 'Restrict' computation.+derivedDelete :: TableDerivable r => (Record Flat r -> Restrict (PlaceHolders p)) -> Delete p derivedDelete = delete  -- | Show delete SQL string

@@ -129,7 +129,7 @@   , eqProp "all'"       all'X     "SELECT ALL T0.int_a0 AS f0 FROM TEST.set_a T0"   , eqProp "update"      assignX-    "UPDATE TEST.set_a SET int_a0 = 0"+    "UPDATE TEST.set_a T0 SET int_a0 = 0"   , eqProp "insert"      registerX     "INSERT INTO TEST.set_c (int_c0, str_c1, int_c2, may_str_c3) VALUES (1, ?, 2, ?)"   , eqChunkedInsert "insert chunked" registerX@@ -656,9 +656,9 @@   , eqProp "updateKey" updateKeyX     "UPDATE TEST.set_a SET str_a1 = ?, str_a2 = ? WHERE int_a0 = ?"   , eqProp "update" updateX-    "UPDATE TEST.set_a SET str_a2 = 'X' WHERE (str_a1 = 'A')"+    "UPDATE TEST.set_a T0 SET str_a2 = 'X' WHERE (T0.str_a1 = 'A')"   , eqProp "delete" deleteX-    "DELETE FROM TEST.set_a WHERE (str_a1 = 'A')"+    "DELETE FROM TEST.set_a T0 WHERE (T0.str_a1 = 'A')"   ]  updateExistsX :: Update ()@@ -698,28 +698,28 @@ correlated :: [Test] correlated =   [ eqProp "update-exists" updateExistsX-    "UPDATE TEST.set_a SET str_a2 = 'X' \-    \ WHERE (EXISTS (SELECT ALL T0.int_b0 AS f0, T0.may_str_b1 AS f1, T0.str_b2 AS f2 \-    \                      FROM TEST.set_b T0 \-    \                     WHERE (T0.int_b0 = int_a0)))"+    "UPDATE TEST.set_a T0 SET str_a2 = 'X' \+    \ WHERE (EXISTS (SELECT ALL T1.int_b0 AS f0, T1.may_str_b1 AS f1, T1.str_b2 AS f2 \+    \                      FROM TEST.set_b T1 \+    \                     WHERE (T1.int_b0 = T0.int_a0)))"    , eqProp "update-scalar" updateScalarX-    "UPDATE TEST.set_a SET str_a2 = 'X' \-    \ WHERE (int_a0 = (SELECT ALL T0.int_b0 AS f0 \-    \                        FROM TEST.set_b T0 \-    \                       WHERE (T0.int_b0 = 0)))"+    "UPDATE TEST.set_a T0 SET str_a2 = 'X' \+    \ WHERE (T0.int_a0 = (SELECT ALL T1.int_b0 AS f0 \+    \                           FROM TEST.set_b T1 \+    \                          WHERE (T1.int_b0 = 0)))"    , eqProp "delete-exists" deleteExistsX-   "DELETE FROM TEST.set_a \-   \ WHERE (EXISTS (SELECT ALL T0.int_b0 AS f0, T0.may_str_b1 AS f1, T0.str_b2 AS f2 \-   \                      FROM TEST.set_b T0 \-   \                     WHERE (T0.int_b0 = int_a0)))"+   "DELETE FROM TEST.set_a T0 \+   \ WHERE (EXISTS (SELECT ALL T1.int_b0 AS f0, T1.may_str_b1 AS f1, T1.str_b2 AS f2 \+   \                      FROM TEST.set_b T1 \+   \                     WHERE (T1.int_b0 = T0.int_a0)))"    , eqProp "delete-scalar" deleteScalarX-    "DELETE FROM TEST.set_a \-    \ WHERE (int_a0 = (SELECT ALL T0.int_b0 AS f0 \-    \                        FROM TEST.set_b T0 \-    \                       WHERE (T0.int_b0 = 0)))"+    "DELETE FROM TEST.set_a T0 \+    \ WHERE (T0.int_a0 = (SELECT ALL T1.int_b0 AS f0 \+    \                        FROM TEST.set_b T1 \+    \                       WHERE (T1.int_b0 = 0)))"   ]  tests :: [Test]

@@ -129,7 +129,7 @@   , eqProp "all'"       all'X     "SELECT ALL T0.int_a0 AS f0 FROM TEST.set_a T0"   , eqProp "update"      assignX-    "UPDATE TEST.set_a SET int_a0 = 0"+    "UPDATE TEST.set_a T0 SET int_a0 = 0"   , eqProp "insert"      registerX     "INSERT INTO TEST.set_c (int_c0, str_c1, int_c2, may_str_c3) VALUES (1, ?, 2, ?)"   , eqChunkedInsert "insert chunked" registerX@@ -563,9 +563,9 @@   , eqProp "updateKey" updateKeyX     "UPDATE TEST.set_a SET str_a1 = ?, str_a2 = ? WHERE int_a0 = ?"   , eqProp "update" updateX-    "UPDATE TEST.set_a SET str_a2 = 'X' WHERE (str_a1 = 'A')"+    "UPDATE TEST.set_a T0 SET str_a2 = 'X' WHERE (T0.str_a1 = 'A')"   , eqProp "delete" deleteX-    "DELETE FROM TEST.set_a WHERE (str_a1 = 'A')"+    "DELETE FROM TEST.set_a T0 WHERE (T0.str_a1 = 'A')"   ]  tests :: [Test]