pg-schema 0.5.2.0 → 0.6.0.0

raw patch · 16 files changed

+558/−301 lines, 16 filesdep ~basedep ~bytestringdep ~postgresql-simplePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, postgresql-simple

API changes (from Hackage documentation)

Files

• ChangeLog.md +10/−1
• pg-schema.cabal +5/−4
• src/PgSchema/Ann.hs +124/−59
• src/PgSchema/DML.hs +4/−3
• src/PgSchema/DML/Delete.hs +6/−6
• src/PgSchema/DML/Select.hs +86/−72
• src/PgSchema/DML/Select/Types.hs +153/−89
• src/PgSchema/DML/Update.hs +7/−8
• src/PgSchema/Generation.hs +6/−5
• src/PgSchema/Schema.hs +73/−1
• src/PgSchema/Types.hs +42/−1
• src/PgSchema/Utils/ShowType.hs +4/−0
• test-gen/Main.hs +1/−1
• test-pgs/Main.hs +2/−2
• test-pgs/Tests/Hierarchy.hs +30/−44
• test-pgs/Utils.hs +5/−5

@@ -1,5 +1,14 @@ # Changelog for pg-schema +## 0.6.0.0++- Using Renamer for QueryParams and Cond+- Improve error messaging+- Support for 'UnsafeCol'+- Check possibility of type conversions for select-list/insert/update (it was broken in 0.5.0)+- Check optional/mandatory for parent references is SELECT+- Added qPathFromHere/qPathToHere. Self-reference require explicit direction in qPathXXX+ ## 0.5.2.0  - Bug fixing (Problem with Self-references)@@ -14,4 +23,4 @@  ## 0.5.0.0 -- First releas on Hackage+- First release on Hackage

@@ -1,6 +1,6 @@ cabal-version:  3.12 name:           pg-schema-version:        0.5.2.0+version:        0.6.0.0 category:       Database author:         Dmitry Olshansky maintainer:     olshanskydr@gmail.com@@ -60,11 +60,12 @@         qLimit 20     @ -    === Module structure+    === Structure of modules      * "PgSchema.Generation" - module with generation functions.       Usually you make executable which generates schema definition using this module.-    * "PgSchema.DML" - module with DML functions. Import this module into your application and use it to generate safe DML for PostgreSQL.+    * "PgSchema.DML" - module with DML functions.+      Import this module into your application and use it to generate safe DML for PostgreSQL.     * "PgSchema.Import" - generated schema module imports this module.  homepage:       https://github.com/odr/pg-schema/tree/master/pg-schema#readme@@ -212,7 +213,7 @@     UndecidableInstances   ghc-options: -Wall -executable test-gen+test-suite test-gen   main-is:          Main.hs   other-modules:     -- Paths and PackageInfo

@@ -7,7 +7,6 @@ import qualified Data.Aeson.Key as Key import Data.Coerce import Data.Singletons.TH (genDefunSymbols)-import Data.Type.Bool import Data.Typeable import Data.Text qualified as T import Data.Kind@@ -18,7 +17,6 @@ import GHC.Generics import GHC.Int import GHC.TypeLits-import GHC.TypeError as TE import PgSchema.Schema import PgSchema.Types import PgSchema.Utils.Internal@@ -47,6 +45,10 @@  type family AnnSch (ann :: Ann) where   AnnSch ('Ann ren sch depth tab) = sch+type family AnnRen (ann :: Ann) where+  AnnRen ('Ann ren sch depth tab) = ren+type family AnnTab (ann :: Ann) where+  AnnTab ('Ann ren sch depth tab) = tab  data ColInfo (p :: Type) = ColInfo   { ciField   :: SymNat@@ -75,6 +77,17 @@  type instance ApplyRenamer RenamerId s = s +type family ApplyRenamerNS (ren :: Renamer) (nns :: NameNSK) :: NameNSK where+  ApplyRenamerNS ren ('NameNS ns n) = 'NameNS ns (ApplyRenamer ren n)++type family MapRen (f :: Renamer) (xs :: [Symbol]) :: [Symbol] where+  MapRen f '[] = '[]+  MapRen f (x ': xs) = ApplyRenamer f x ': MapRen f xs++type family MapRenPath (f :: Renamer) (xs :: [(Symbol, PathKind)]) :: [(Symbol, PathKind)] where+  MapRenPath f '[] = '[]+  MapRenPath f ('(x, k) ': xs) = '(ApplyRenamer f x, k) ': MapRenPath f xs+ -------------------------------------------------------------------------------- -- Case dispatch --------------------------------------------------------------------------------@@ -119,12 +132,15 @@  type family Col (ann :: Ann) (fld :: Symbol) t :: [ColInfo NameNSK] where   Col ann fld () = '[]-  Col ann fld (Aggr ACount Int64) =-    '[ 'ColInfo '(fld, 0) (Aggr ACount Int64) fld+  Col ('Ann ren _s _d _t) fld (Aggr ACount Int64) =+    '[ 'ColInfo '(fld, 0) (Aggr ACount Int64) (ApplyRenamer ren fld)       ('RFAggr ('FldDef ("pg_catalog" ->> "int8") False False) 'ACount 'True) ]-  Col ann fld (Aggr' ACount Int64) =-    '[ 'ColInfo '(fld, 0) (Aggr' ACount Int64) fld+  Col ('Ann ren _s _d _t) fld (Aggr' ACount Int64) =+    '[ 'ColInfo '(fld, 0) (Aggr' ACount Int64) (ApplyRenamer ren fld)       ('RFAggr ('FldDef ("pg_catalog" ->> "int8") False False) 'ACount 'True) ]+  Col ('Ann ren sch _d tab) fld (UnsafeCol flds expr t) =+    '[ 'ColInfo '(fld, 0) (PgTag '(sch, tab) (UnsafeCol (MapRen ren flds) expr t)) (ApplyRenamer ren fld)+      ('RFUnsafe (MapRen ren flds) expr) ]   Col ('Ann ren sch d tab) fld t =     ColFI ('Ann ren sch d tab) fld (TDBFieldInfo sch tab (ApplyRenamer ren fld)) t @@ -235,16 +251,19 @@       where         keyTxt = demote @(NameSymNat sn) +-- Note: we use "split ~" instead of " '(colsA, colsB) ~ " to avoid ambiguity. instance   ( ca ~ ColsCaseOf a, cb ~ ColsCaseOf b-  , '(colsA, colsB) ~ SplitAt (Length (Cols ann a)) cols+  , split ~ SplitAt (Length (Cols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , ToJSONCols ann ca colsA a, ToJSONCols ann cb colsB b )   => ToJSONCols ann 'NonGenericCase cols (a :. b) where     toPairs (a :. b) = toPairs @ann @ca @colsA a <> toPairs @ann @cb @colsB b  instance   ( ca ~ ColsCaseOf a, cb ~ ColsCaseOf b-  , '(colsA, colsB) ~ SplitAt (Length (Cols ann a)) cols+  , split ~ SplitAt (Length (Cols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , FromJSONCols ann ca colsA a, FromJSONCols ann cb colsB b)   => FromJSONCols ann 'NonGenericCase cols (a :. b) where     parseJSONCols v =@@ -280,13 +299,15 @@  -- (:*:) instance-  ( '(colsA, colsB) ~ SplitAt (Length (GCols ann a)) cols+  ( split ~ SplitAt (Length (GCols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , GToJSONCols ann colsA a, GToJSONCols ann colsB b )   => GToJSONCols ann cols (a :*: b) where     gToPairs (a :*: b) = gToPairs @ann @colsA a <> gToPairs @ann @colsB b  instance-  ( '(colsA, colsB) ~ SplitAt (Length (GCols ann a)) cols+  ( split ~ SplitAt (Length (GCols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , GFromJSONCols ann colsA a, GFromJSONCols ann colsB b )   => GFromJSONCols ann cols (a :*: b) where     gParseJSONCols v =@@ -319,10 +340,6 @@   => FromField (PgTag (ann :: Ann) r) where     fromField = fromJSONField --- instance (FromJSON (PgTag ann r), Typeable ann, Typeable r)---   => FromField (Maybe (PgTag (ann :: Ann) r)) where---     fromField = fromJSONField- instance (FromJSON (PgTag ann r), Typeable ann, Typeable r)   => FromField [PgTag (ann :: Ann) r] where     fromField = fromJSONField@@ -372,17 +389,21 @@  instance   ( ca ~ ColsCaseOf a, cb ~ ColsCaseOf b-  , '(colsA, colsB) ~ SplitAt (Length (Cols ann a)) cols+  , split ~ SplitAt (Length (Cols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , ToRowCols ann ca colsA a, ToRowCols ann cb colsB b )   => ToRowCols ann 'NonGenericCase cols (a :. b) where   toRowCols (a :. b) = toRowCols @ann @ca @colsA a <> toRowCols @ann @cb @colsB b  instance   ( ca ~ ColsCaseOf a, cb ~ ColsCaseOf b-  , '(colsA, colsB) ~ SplitAt (Length (Cols ann a)) cols+  , split ~ SplitAt (Length (Cols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , FromRowCols ann ca colsA a, FromRowCols ann cb colsB b )   => FromRowCols ann 'NonGenericCase cols (a :. b) where-  fromRowCols = (:.) <$> fromRowCols @ann @ca @colsA <*> fromRowCols @ann @cb @colsB+  fromRowCols = (:.)+    <$> fromRowCols @ann @ca @(Fst split)+    <*> fromRowCols @ann @cb @(Snd split)  -------------------------------------------------------------------------------- -- Generic: through Rep r@@ -411,13 +432,15 @@     gFromRowCols = fmap (M1 . M1) (gFromRowCols @ann @cols)  instance-  ( '(colsA, colsB) ~ SplitAt (Length (GCols ann a)) cols-  , GToRowCols   ann colsA a, GToRowCols   ann colsB b )+  ( split ~ SplitAt (Length (GCols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split+  , GToRowCols ann colsA a, GToRowCols ann colsB b )   => GToRowCols ann cols (a :*: b) where     gToRowCols (a :*: b) = gToRowCols @ann @colsA a <> gToRowCols @ann @colsB b  instance-  ( '(colsA, colsB) ~ SplitAt (Length (GCols ann a)) cols+  ( split ~ SplitAt (Length (GCols ann a)) cols+  , colsA ~ Fst split, colsB ~ Snd split   , GFromRowCols ann colsA a, GFromRowCols ann colsB b )   => GFromRowCols ann cols (a :*: b) where     gFromRowCols = (:*:) <$> gFromRowCols @ann @colsA <*> gFromRowCols @ann @colsB@@ -453,45 +476,49 @@ class CRecInfoCols (ann :: Ann) (cols :: [ColInfo NameNSK]) where   getFields :: [FieldInfo T.Text] -class CFldInfo (ann :: Ann) (fld :: RecField' Symbol NameNSK) t where+class CFldInfo (ann :: Ann) (fldDbName :: Symbol) (fld :: RecField' Symbol NameNSK) t where   getFldInfo :: RecField (RecordInfo T.Text)  instance-  (ann ~ 'Ann ren sch d tab, SingI tab, cols ~ Cols ann r, CRecInfoCols ann cols)+  (SingI (AnnTab ann), cols ~ Cols ann r, CRecInfoCols ann cols)   => CRecInfo ann r where-  getRecordInfo = RecordInfo (demote @tab) (getFields @ann @cols)+  getRecordInfo = RecordInfo (demote @(AnnTab ann)) (getFields @ann @cols)  instance CRecInfoCols ann '[] where getFields = []  instance-  (KnownSymNat sn, KnownSymbol db, CFldInfo ann fi t, CRecInfoCols ann cols)+  (KnownSymNat sn, KnownSymbol db, CFldInfo ann db fi t, CRecInfoCols ann cols)   => CRecInfoCols ann ('ColInfo sn t db fi ': cols) where   getFields = FieldInfo     { fieldName   = demote @(NameSymNat sn)     , fieldDbName = demote @db-    , fieldKind   = getFldInfo @ann @fi @t } : getFields @ann @cols+    , fieldKind   = getFldInfo @ann @db @fi @t } : getFields @ann @cols -instance ToStar fd => CFldInfo ann ('RFPlain fd) t where+instance (ToStar fd, CanConvert (AnnSch ann) (AnnTab ann) fldDbName fd t) => CFldInfo ann fldDbName ('RFPlain fd) t where   getFldInfo = RFPlain (demote @fd)  instance (ToStar fd, ToStar af, ToStar b) =>-  CFldInfo ann ('RFAggr fd af b) t where+  CFldInfo ann _fldDbName ('RFAggr fd af b) t where   getFldInfo = RFAggr (demote @fd) (demote @af) (demote @b) +instance (ToStar flds, ToStar expr) =>+  CFldInfo ann _fldDbName ('RFUnsafe flds expr) t where+  getFldInfo = RFUnsafe (demote @flds) (demote @expr)+ type family AnnRefTabDepth (ann :: Ann) refTab :: Ann where   AnnRefTabDepth ('Ann ren sch d tab) refTab =     'Ann ren sch (DecDepth ('Ann ren sch d tab)) refTab  instance (CRecInfo ann' r, ToStar refs, ann' ~ AnnRefTabDepth ann fromTab)-  => CFldInfo ann ('RFToHere fromTab refs) [PgTag ann' r] where+  => CFldInfo ann _fldDbName ('RFToHere fromTab refs) [PgTag ann' r] where   getFldInfo = RFToHere (getRecordInfo @ann' @r) (demote @refs) -instance (CRecInfo ann' r, ToStar refs, ann' ~ AnnRefTabDepth ann toTab)-  => CFldInfo ann ('RFFromHere toTab refs) (Maybe (PgTag ann' r)) where+instance (CRecInfo ann' r, ToStar refs, ann' ~ AnnRefTabDepth ann toTab, CheckRef ann _fldDbName(HasNullableRefs refs) 'True)+  => CFldInfo ann _fldDbName ('RFFromHere toTab refs) (Maybe (PgTag ann' r)) where   getFldInfo = RFFromHere (getRecordInfo @ann' @r) (demote @refs) -instance (CRecInfo ann' r, ToStar refs, ann' ~ AnnRefTabDepth ann toTab)-  => CFldInfo ann ('RFFromHere toTab refs) (PgTag ann' r) where+instance (CRecInfo ann' r, ToStar refs, ann' ~ AnnRefTabDepth ann toTab, CheckRef ann _fldDbName(HasNullableRefs refs) 'False)+  => CFldInfo ann _fldDbName ('RFFromHere toTab refs) (PgTag ann' r) where   getFldInfo = RFFromHere (getRecordInfo @ann' @r) (demote @refs)  --------------------------------------------------------------------------------@@ -515,19 +542,29 @@   IsPlainRecField ('RFSelfRef tab rs)  = 'False   IsPlainRecField fi        = 'True -type family AllPlainCols (cols :: [ColInfo NameNSK]) :: Bool where-  AllPlainCols '[] = 'True-  AllPlainCols ('ColInfo sn t db fi ': cs) = IsPlainRecField fi && AllPlainCols cs+type family NotPlainCols (cols :: [ColInfo NameNSK]) (rs :: [Symbol]) :: [Symbol] where+  NotPlainCols '[] rs = rs+  NotPlainCols ('ColInfo sn t db fi ': cs) rs =+    NotPlainCols cs (AppNotPlain rs db (IsPlainRecField fi)) +type family AppNotPlain (rs :: [Symbol]) (db :: Symbol) (b :: Bool) :: [Symbol] where+  AppNotPlain rs db 'True = rs+  AppNotPlain rs db 'False = db ': rs+ -- | All fields are plain (no RFToHere/RFFromHere)-type family AllPlain (ann :: Ann) (r :: Type) :: Constraint where-  AllPlain ann r = Assert (AllPlainCols (Cols ann r))-    (TypeError-      (  Text "Not all fields in record are 'plain' (no relations allowed)."-      :$$: Text "Ann:   " :<>: ShowType ann-      :$$: Text "Type:  " :<>: ShowType r-      :$$: Text "Cols:  " :<>: ShowType (Cols ann r) ))+type AllPlain (ann :: Ann) (r :: Type) = AllPlainRS ann (NotPlainCols (Cols ann r) '[]) r +type family AllPlainRS (ann :: Ann) (rs :: [Symbol]) (r :: Type) :: Constraint where+  AllPlainRS ann '[] r = ()+  AllPlainRS ann rs r = TypeError+    (  Text "Not all fields in record are 'plain' (no relations allowed)."+    :$$: Text ""+    :$$: Text "Not plain cols: " :<>: ShowType rs+    :$$: Text ""+    :$$: Text "Ann:   " :<>: ShowType ann+    :$$: Text "Cols:  " :<>: ShowType (Cols ann r)+    :$$: Text "" )+ -------------------------------------------------------------------------------- -- Type-level RecordInfo for Ann --------------------------------------------------------------------------------@@ -555,9 +592,9 @@ -- and build RecField' Symbol (RecordInfo Symbol) with TRecordInfo for children. type family TFldInfo (ann :: Ann) (fi :: RecField' Symbol NameNSK) t   :: RecField' Symbol (RecordInfo Symbol) where-  TFldInfo ann ('RFPlain fd) t      = 'RFPlain fd-  TFldInfo ann ('RFAggr  fd af b) t = 'RFAggr fd af b-  TFldInfo ann ('RFEmpty s)    t    = 'RFEmpty s+  TFldInfo ann ('RFPlain fd) t = 'RFPlain fd+  TFldInfo ann ('RFAggr fd af b) t = 'RFAggr fd af b+  TFldInfo ann ('RFEmpty s) t = 'RFEmpty s   TFldInfo ('Ann ren sch d tab) ('RFToHere (toTab :: NameNSK) refs)     [PgTag ('Ann ren sch d' toTab) rChild] =     'RFToHere ('RecordInfo toTab (TRecordInfo ('Ann ren sch d' toTab) rChild)) refs@@ -585,30 +622,58 @@   TRecordInfo ann r = TRecordInfoCols ann (Cols ann r)  --------------------------------------------------------------------------------+-- CheckRef+--------------------------------------------------------------------------------+type family CheckRef (ann :: Ann) (fldDbName :: Symbol)+  (hasNullable :: Bool) (expectMaybe :: Bool) :: Constraint where+  CheckRef ('Ann ren sch d tab) fldDbName 'True 'False =+    TypeError+      (  Text "relation result must be Maybe because"+      :$$: Text "foreign key in this relation is nullable."+      :$$: Text ""+      :$$: Text "Table:      " :<>: ShowType tab+      :$$: Text "Relation:   " :<>: ShowType fldDbName+      :$$: Text "" )+  CheckRef ('Ann ren sch d tab) fldDbName 'False 'True =+    TypeError+      (  Text "relation result must NOT be Maybe because"+      :$$: Text "foreign key in this relation is NOT NULL."+      :$$: Text ""+      :$$: Text "Table:      " :<>: ShowType tab+      :$$: Text "Relation:   " :<>: ShowType fldDbName+      :$$: Text "" )+  CheckRef ann fldDbName b b = ()+-------------------------------------------------------------------------------- -- Node-level checks for Mandatory / PK (analogue of CheckNodeAll*) --------------------------------------------------------------------------------  -- | One-table check that all mandatory fields are present -- rs: list of columns that are already "covered" (including those that come from Reference) type family CheckAllMandatory (ann :: Ann) (rs :: [Symbol]) :: Constraint where-  CheckAllMandatory ('Ann ren sch d tab) rs = TE.Assert-    (SP.Null (RestMandatory sch tab rs))-    (TypeError-      (  Text "We can't insert data because not all mandatory fields are present."-      :$$: Text "Table: " :<>: ShowType tab-      :$$: Text "Missing mandatory fields: " :<>: ShowType (RestMandatory sch tab rs) ))+  CheckAllMandatory ('Ann ren sch d tab) rs =+    CheckAllMandatory' (RestMandatory sch tab rs) ('Ann ren sch d tab) rs +type family CheckAllMandatory' (rest :: [Symbol]) (ann :: Ann) (rs :: [Symbol]) :: Constraint where+  CheckAllMandatory' '[] ann rs = ()+  CheckAllMandatory' rest ('Ann ren sch d tab) rs = TypeError+    (  Text "We can't insert data because not all mandatory fields are present."+    :$$: Text "Table: " :<>: ShowType tab+    :$$: Text "Missing mandatory fields: " :<>: ShowType rest )+ -- | One-table check that all mandatory fields are present -- or all PK fields are present type family CheckAllMandatoryOrHasPK (ann :: Ann) (rs :: [Symbol]) :: Constraint where-  CheckAllMandatoryOrHasPK ('Ann ren sch d tab) rs = TE.Assert-    ( SP.Null (RestMandatory sch tab rs)-      || SP.Null (RestPK sch tab rs) )-    (TypeError-      (  Text "We can't upsert data because for table " :<>: ShowType tab-      :$$: Text "either not all mandatory fields or not all PK fields are present."-      :$$: Text "Missing mandatory fields: " :<>: ShowType (RestMandatory sch tab rs)-      :$$: Text "Missing PK fields: " :<>: ShowType (RestPK sch tab rs) ))+  CheckAllMandatoryOrHasPK ('Ann ren sch d tab) rs = CheckAllMandatoryOrHasPK'+    (RestMandatory sch tab rs) (RestPK sch tab rs) ('Ann ren sch d tab) rs++type family CheckAllMandatoryOrHasPK' (restMandatory :: [Symbol]) (restPK :: [Symbol]) (ann :: Ann) (rs :: [Symbol]) :: Constraint where+  CheckAllMandatoryOrHasPK' '[] rpk ann rs = ()+  CheckAllMandatoryOrHasPK' rm '[] ann rs = ()+  CheckAllMandatoryOrHasPK' rm rpk ('Ann ren sch d tab) rs = TypeError+    (  Text "We can't upsert data because for table " :<>: ShowType tab+    :$$: Text "either not all mandatory fields or not all PK fields are present."+    :$$: Text "Missing mandatory fields: " :<>: ShowType rm+    :$$: Text "Missing PK fields: " :<>: ShowType rpk )  genDefunSymbols [ ''CheckAllMandatory, ''CheckAllMandatoryOrHasPK] 

@@ -74,7 +74,8 @@     selectSch, selectText, Selectable   -- *** Monad to set Query Params   , MonadQP, qpEmpty-  , qRoot, qPath, qWhere, qOrderBy, qDistinct, qDistinctOn, qLimit, qOffset+  , qRoot, qPath, qPathFromHere, qPathToHere, qWhere, qOrderBy+  , qDistinct, qDistinctOn, qLimit, qOffset   -- **** Internals   , QueryParam(..), CondWithPath(..), OrdWithPath(..), LimOffWithPath(..), DistWithPath(..)   -- *** Conditions@@ -84,7 +85,7 @@   ,(~=?),(~~?)   , (|||), (&&&), pnot, pnull, pin, pinArr   , pparent, pchild, TabParam(..), defTabParam-  , pUnsafeCond+  , pUnsafeCond, UnsafeCol(..)   , Cond(..), Cmp(..), BoolOp(..)   , CondMonad, SomeToField(..), showCmp, tabPref, qual   , CDBField, CDBValue, CDBFieldNullable, CRelDef@@ -107,7 +108,7 @@   -- * Types   , Ann(..), ToStar   -- ** Renamers-  , RenamerId, CamelToSnake, Renamer, ApplyRenamer+  , RenamerId, CamelToSnake, Renamer, ApplyRenamer, ApplyRenamerNS   -- ** PgTag types   , type (:=), (=:), PgTag(..),   -- | Re-export from postgresql-simple

@@ -14,17 +14,17 @@  -- | Delete records in table by condition. ---deleteByCond :: forall sch t -> SingI t =>-  Connection -> Cond sch t -> IO (Int64, (Text,[SomeToField]))-deleteByCond sch t conn cond = traceShow' (q,ps)+deleteByCond :: forall ren sch t -> SingI t =>+  Connection -> Cond ren sch t -> IO (Int64, (Text,[SomeToField]))+deleteByCond ren sch t conn cond = traceShow' (q,ps)   $ (,(q,ps)) <$> execute conn (fromString $ T.unpack q) ps   where-    (q, ps) = deleteText @sch @t cond+    (q, ps) = deleteText @ren @sch @t cond  -- | Construct SQL text for deleting records by condition. ---deleteText :: forall sch t s. (IsString s, Monoid s, SingI t) =>-  Cond sch t -> (s, [SomeToField])+deleteText :: forall ren sch t s. (IsString s, Monoid s, SingI t) =>+  Cond ren sch t -> (s, [SomeToField]) deleteText cond =   ("delete from " <> tn <> " t0 " <> fromText whereTxt, condParams )   where

@@ -27,14 +27,14 @@ import GHC.TypeLits import PgSchema.Types import PgSchema.Utils.Internal-import PgSchema.Utils.TF (Snd)+import PgSchema.Utils.TF import Prelude as P  -data QueryRead sch t = QueryRead+data QueryRead ren sch t = QueryRead   { qrCurrTabNum  :: Int-  , qrPath        :: [Text]-  , qrParam       :: QueryParam sch t }+  , qrPath        :: [(Text, PathKind)]+  , qrParam       :: QueryParam ren sch t }  data ParentInfo = ParentInfo   { piRelDbName   :: Text@@ -42,7 +42,7 @@   , piToNum       :: Int   , piParentTab   :: NameNS   , piRefs        :: [Ref' Text]-  , piPath        :: [Text] }+  , piPath        :: [(Text, PathKind)] }   deriving Show  data QueryState = QueryState@@ -50,7 +50,7 @@   , qsParents     :: [ParentInfo] }   deriving Show -type MonadQuery sch t m = (MonadRWS (QueryRead sch t) [SomeToField] QueryState m)+type MonadQuery ren sch t m = (MonadRWS (QueryRead ren sch t) [SomeToField] QueryState m)  type Selectable ann r = (CRecInfo ann r, FromRow (PgTag ann r)) @@ -72,18 +72,19 @@ -- -- Build 'QueryParam' with the 'MonadQP' API. ---selectSch :: forall ann -> forall r. (Selectable ann r, ann ~ 'Ann ren sch d tab)-  => Connection -> QueryParam sch tab -> IO ([r], (Text,[SomeToField]))+selectSch :: forall ann -> forall r. Selectable ann r+  => Connection -> QueryParam (AnnRen ann) (AnnSch ann) (AnnTab ann)+  -> IO ([r], (Text,[SomeToField])) selectSch ann @r conn (selectText ann @r -> (sql,fs)) =   trace' ("\n\n" <> T.unpack sql <> "\n\n" <> P.show fs <> "\n\n")   $ (,(sql,fs)) . fmap (unPgTag @ann @r) <$> query conn (fromString $ T.unpack sql) fs  -- | Return the generated @SELECT@ SQL text (and bind parameters), e.g. for debugging.-selectText :: forall ann -> forall r. (CRecInfo ann r, ann ~ 'Ann ren sch d tab)-  => QueryParam sch tab -> (Text,[SomeToField])+selectText :: forall ann -> forall r. (CRecInfo ann r)+  => QueryParam (AnnRen ann) (AnnSch ann) (AnnTab ann) -> (Text,[SomeToField]) selectText ann @r qp = evalRWS (selectM "" (getRecordInfo @ann @r)) (qr0 qp) qs0 -qr0 :: QueryParam sch tab -> QueryRead sch tab+qr0 :: QueryParam ren sch tab -> QueryRead ren sch tab qr0 qrParam = QueryRead   { qrCurrTabNum = 0 , qrPath = [] , qrParam } @@ -109,7 +110,7 @@  instance KnownSymbol s => Monoid (TextI s) where mempty = TextI mempty -selectM :: MonadQuery sch t m => Text -> RecordInfo Text -> m Text+selectM :: forall ren sch t m. MonadQuery ren sch t m => Text -> RecordInfo Text -> m Text selectM refTxt ri = do   QueryRead {..} <- ask   (fmap two -> flds) <- traverse fieldM ri.fields@@ -119,7 +120,7 @@   let     basePath = L.reverse qrPath     (unTextI -> condText, condPars) = F.fold $ L.reverse-      $ mapMaybe (\(CondWithPath @path cond) -> let p = demote @path in+      $ mapMaybe (\(CondWithPath @path cond) -> let p = demote @(MapRenPath ren path) in         if           | not (basePath `L.isPrefixOf` p) -> Nothing           | p == basePath -> Just $ first TextI $ pgCond qrCurrTabNum cond@@ -127,7 +128,7 @@             <&> \pari -> first (TextI @" and ") $ pgCond pari.piToNum cond         ) qrParam.qpConds     (unTextI -> ordText, ordPars) = F.fold $ L.reverse-      $ mapMaybe (\(OrdWithPath @path ord) -> let p = demote @path in+      $ mapMaybe (\(OrdWithPath @path ord) -> let p = demote @(MapRenPath ren path) in         if           | not (basePath `L.isPrefixOf` p) -> Nothing           | p == basePath -> Just $ pgOrd qrCurrTabNum ord@@ -135,7 +136,7 @@             <&> \pari -> pgOrd pari.piToNum ord         ) qrParam.qpOrds     (distTexts, distPars) = F.fold $ L.reverse-      $ mapMaybe (\(DistWithPath @path dist) -> let p = demote @path in+      $ mapMaybe (\(DistWithPath @path dist) -> let p = demote @(MapRenPath ren path) in         if           | not (basePath `L.isPrefixOf` p) -> Nothing           | p == basePath -> Just $ pgDist qrCurrTabNum dist@@ -180,9 +181,17 @@     <> orderText     <> qsLimOff +renderUnsafeExpr :: Int -> [Text] -> Text -> Text+renderUnsafeExpr n ps = T.concat+  . P.zipWith (<>) (mempty : ((("t" <> show' n <> ".") <> ) <$> ps))+  . T.splitOn "?"++-- >>> renderUnsafeExpr 5 ["a", "b"] "foo ? bar ? baz"+-- "foo t5.a bar t5.b baz"+ -- | SQL text for the column expression, result alias, and emptiness-test expression -- (non-obvious for nested relation fields).-fieldM :: MonadQuery sch tab m => FieldInfo Text -> m (Text, Text, Text)+fieldM :: MonadQuery ren sch tab m => FieldInfo Text -> m (Text, Text, Text) fieldM fi = case fi.fieldKind of   RFEmpty s -> pure ("null", s, "true")   RFSelfRef{} -> error "Impossible: RFSelfRef should be changed to RFFromHere or RFToHere"@@ -196,6 +205,10 @@     pure case fname of       "count" -> ("count(*)", fi.fieldName, " false")       _ -> (val, fi.fieldName, val <> " is null")+  RFUnsafe ps expr -> do+    n <- asks qrCurrTabNum+    let val = renderUnsafeExpr n ps expr+    pure (val, fi.fieldName, val <> " is null")   RFFromHere ri refs -> do     QueryRead {..} <- ask     modify \QueryState{qsLastTabNum = (+1) -> n2, qsParents} -> QueryState@@ -207,10 +220,10 @@         , piToNum     = n2         , piParentTab = ri.tabName         , piRefs      = refs-        , piPath      = fi.fieldDbName : qrPath } : qsParents }+        , piPath      = (fi.fieldDbName, FromHere) : qrPath } : qsParents }     n2 <- gets qsLastTabNum     (flds, pars) <- listen $ local-      (\qr -> qr{ qrCurrTabNum = n2, qrPath = fi.fieldDbName : qrPath })+      (\qr -> qr{ qrCurrTabNum = n2, qrPath = (fi.fieldDbName, FromHere) : qrPath })       $ traverse fieldM ri.fields     val <- if L.any (fdNullable . fromDef) refs       then do@@ -224,7 +237,7 @@     QueryState {qsLastTabNum = (+1) -> tabNum, qsParents} <- get     modify (const $ QueryState tabNum [])     selText <- local-      (\qr -> qr { qrCurrTabNum = tabNum, qrPath = fi.fieldDbName : qrPath })+      (\qr -> qr { qrCurrTabNum = tabNum, qrPath = (fi.fieldDbName, ToHere) : qrPath })       $ selectM (refCond tabNum qrCurrTabNum refs) ri     modify (\qs -> qs { qsParents = qsParents })     let@@ -249,20 +262,20 @@         fldt n = (("t" <> show' n <> ".") <>)  withLOWithPath-  :: forall sch t r. (LO -> r) -> [Text] -> LimOffWithPath sch t -> Maybe r+  :: forall ren sch t r. (LO -> r) -> [(Text, PathKind)] -> LimOffWithPath ren sch t -> Maybe r withLOWithPath f p (LimOffWithPath @p lo) =-  guard (p == demote @p) >> pure (f lo)+  guard (p == demote @(MapRenPath ren p)) >> pure (f lo)  withLOsWithPath-  :: forall sch t r. (LO -> r) -> [Text] -> [LimOffWithPath sch t] -> Maybe r+  :: forall ren sch t r. (LO -> r) -> [(Text, PathKind)] -> [LimOffWithPath ren sch t] -> Maybe r withLOsWithPath f p = join . L.find isJust . L.map (withLOWithPath f p) -lowp :: forall sch t. forall (path::[Symbol]) ->-  (ToStar path, TabPath sch t path-  , Snd (TabOnPath2 sch t path) ~ RelMany) => LO -> LimOffWithPath sch t+lowp :: forall ren sch t. forall (path::[(Symbol, PathKind)]) ->+  (ToStar (MapRenPath ren path), TabDPath sch t (MapRenPath ren path)+  , Snd (TabOnDPath2 sch t (MapRenPath ren path)) ~ RelMany) => LO -> LimOffWithPath ren sch t lowp p = LimOffWithPath @p -rootLO :: forall sch t. LO -> LimOffWithPath sch t+rootLO :: forall ren sch t. LO -> LimOffWithPath ren sch t rootLO = lowp []  convLO :: LO -> Text@@ -270,7 +283,7 @@   maybe "" ((" limit " <>) . show') ml    <> maybe "" ((" offset " <>) . show') mo -loByPath :: forall sch t. [Text] -> [LimOffWithPath sch t] -> Text+loByPath :: forall ren sch t. [(Text, PathKind)] -> [LimOffWithPath ren sch t] -> Text loByPath p = fromMaybe mempty . withLOsWithPath convLO p  runCond :: Int -> CondMonad a -> (a,[SomeToField])@@ -285,26 +298,26 @@ qual = tabPref <&> (<> "." <> (demote @fld))  ---convCond :: forall sch t . Cond sch t -> CondMonad Text+convCond :: forall ren sch t . Cond ren sch t -> CondMonad Text convCond = \case   EmptyCond -> pure mempty   Cmp @n cmp v -> do     tell [SomeToField v]-    qual @n <&> (<> " " <> showCmp cmp <> " ?")+    qual @(ApplyRenamer ren n) <&> (<> " " <> showCmp cmp <> " ?")   In @n (NE.toList -> vs) -> do     tell [SomeToField $ PGArray vs]-    qual @n <&> (<> " = any(?::" <> qualName (getFldDef @sch @t @n).fdType <> "[])")+    qual @(ApplyRenamer ren n) <&> (<> " = any(?::" <> qualName (getFldDef @sch @t @(ApplyRenamer ren n)).fdType <> "[])")   InArr @n vs -> do     tell [SomeToField $ PGArray vs]-    qual @n <&> (<> " = any(?::" <> qualName (getFldDef @sch @t @n).fdType <> "[])")-  Null @n -> qual @n <&> (<> " is null")+    qual @(ApplyRenamer ren n) <&> (<> " = any(?::" <> qualName (getFldDef @sch @t @(ApplyRenamer ren n)).fdType <> "[])")+  Null @n -> qual @(ApplyRenamer ren n) <&> (<> " is null")   Not c -> getNot <$> convCond c   BoolOp bo c1 c2 -> getBoolOp bo <$> convCond c1 <*> convCond c2-  Child @_ @ref tabParam cond ->-    getRef @(RdFrom (TRelDef sch ref)) True (demote @(TRelDef sch ref)).rdCols+  Child @_ @_ @ref tabParam cond ->+    getRef @(RdFrom (TRelDef sch (ApplyRenamerNS ren ref))) True (demote @(TRelDef sch (ApplyRenamerNS ren ref))).rdCols       tabParam cond-  Parent @_ @ref cond ->-    getRef @(RdTo (TRelDef sch ref)) False (demote @(TRelDef sch ref)).rdCols+  Parent @_ @_ @ref cond ->+    getRef @(RdTo (TRelDef sch (ApplyRenamerNS ren ref))) False (demote @(TRelDef sch (ApplyRenamerNS ren ref))).rdCols       defTabParam cond   UnsafeCond m -> m   where@@ -319,7 +332,7 @@         Or -> "(" <> cc1 <> " or " <> cc2 <>  ")"     getRef       :: forall tab. CTabDef sch tab-      => Bool -> [(Text, Text)] -> TabParam sch tab -> Cond sch tab+      => Bool -> [(Text, Text)] -> TabParam ren sch tab -> Cond ren sch tab       -> CondMonad Text     getRef isChild cols tabParam cond = do       tpp <- tabPref@@ -349,77 +362,78 @@           where             tn = qualName $ demote @tab -pgCond :: forall sch t . Int -> Cond sch t -> (Text, [SomeToField])+pgCond :: forall ren sch t . Int -> Cond ren sch t -> (Text, [SomeToField]) pgCond n cond = evalRWS (convCond cond) ("q", pure n) 0 -pgOrd :: forall sch t. Int -> [OrdFld sch t] -> (TextI ",", [SomeToField])+pgOrd :: forall ren sch t. Int -> [OrdFld ren sch t] -> (TextI ",", [SomeToField]) pgOrd n ord = evalRWS (convOrd ord) ("o", pure n) 0 -pgDist :: forall sch t. Int -> Dist sch t -> (DistTexts, [SomeToField])+pgDist :: forall ren sch t. Int -> Dist ren sch t -> (DistTexts, [SomeToField]) pgDist n dist = evalRWS (convDist dist) ("o", pure n) 0 -withCondWithPath :: forall sch t r. (forall t'. Cond sch t' -> r) ->-  [Text] -> CondWithPath sch t -> Maybe r-withCondWithPath f p (CondWithPath @p' cond) = f cond <$ guard (p == demote @p')+withCondWithPath :: forall ren sch t r. (forall t'. Cond ren sch t' -> r) ->+  [(Text, PathKind)] -> CondWithPath ren sch t -> Maybe r+withCondWithPath f p (CondWithPath @p' cond) = f cond <$ guard (p == demote @(MapRenPath ren p')) -withCondsWithPath :: forall sch t r. (forall t'. Cond sch t' -> r) ->-  [Text] -> [CondWithPath sch t] -> Maybe r+withCondsWithPath :: forall ren sch t r. (forall t'. Cond ren sch t' -> r) ->+  [(Text, PathKind)] -> [CondWithPath ren sch t] -> Maybe r withCondsWithPath f p = join . L.find isJust . L.map (withCondWithPath f p) -cwp :: forall path -> forall sch t t1.-  (t1 ~ TabOnPath sch t path, ToStar path) => Cond sch t1 -> CondWithPath sch t+cwp :: forall path -> forall ren sch t t1.+  (t1 ~ TabOnDPath sch t (MapRenPath ren path), ToStar (MapRenPath ren path))+  => Cond ren sch t1 -> CondWithPath ren sch t cwp p = CondWithPath @p -rootCond :: Cond sch t -> CondWithPath sch t+rootCond :: Cond ren sch t -> CondWithPath ren sch t rootCond = cwp [] -condByPath :: Int -> [Text] -> [CondWithPath sch t] -> (Text, [SomeToField])+condByPath :: Int -> [(Text, PathKind)] -> [CondWithPath ren sch t] -> (Text, [SomeToField]) condByPath num p = F.fold . withCondsWithPath (pgCond num) p -ordByPath :: Int -> [Text] -> [OrdWithPath sch t] -> (TextI ",", [SomeToField])+ordByPath :: Int -> [(Text, PathKind)] -> [OrdWithPath ren sch t] -> (TextI ",", [SomeToField]) ordByPath num p = F.fold . withOrdsWithPath (pgOrd num) p -distByPath :: Int -> [Text] -> [DistWithPath sch t] -> (DistTexts, [SomeToField])+distByPath :: Int -> [(Text, PathKind)] -> [DistWithPath ren sch t] -> (DistTexts, [SomeToField]) distByPath num p = F.fold . withDistsWithPath (pgDist num) p -withOrdWithPath :: forall sch t r. (forall t'. [OrdFld sch t'] -> r) ->-  [Text] -> OrdWithPath sch t -> Maybe r-withOrdWithPath f p (OrdWithPath @p ord) = f ord <$ guard (p == demote @p)+withOrdWithPath :: forall ren sch t r. (forall t'. [OrdFld ren sch t'] -> r) ->+  [(Text, PathKind)] -> OrdWithPath ren sch t -> Maybe r+withOrdWithPath f p (OrdWithPath @p ord) = f ord <$ guard (p == demote @(MapRenPath ren p)) -withDistWithPath :: forall sch t r. (forall t'. Dist sch t' -> r) ->-  [Text] -> DistWithPath sch t -> Maybe r-withDistWithPath f p (DistWithPath @p dist) = f dist <$ guard (p == demote @p)+withDistWithPath :: forall ren sch t r. (forall t'. Dist ren sch t' -> r) ->+  [(Text, PathKind)] -> DistWithPath ren sch t -> Maybe r+withDistWithPath f p (DistWithPath @p dist) = f dist <$ guard (p == demote @(MapRenPath ren p))  ---withOrdsWithPath :: forall sch t r . (forall t'. [OrdFld sch t'] -> r) ->-  [Text] -> [OrdWithPath sch t] -> Maybe r+withOrdsWithPath :: forall ren sch t r . (forall t'. [OrdFld ren sch t'] -> r) ->+  [(Text, PathKind)] -> [OrdWithPath ren sch t] -> Maybe r withOrdsWithPath f p = join . L.find isJust . L.map (withOrdWithPath f p) -withDistsWithPath :: forall sch t r . (forall t'. Dist sch t' -> r) ->-  [Text] -> [DistWithPath sch t] -> Maybe r+withDistsWithPath :: forall ren sch t r . (forall t'. Dist ren sch t' -> r) ->+  [(Text, PathKind)] -> [DistWithPath ren sch t] -> Maybe r withDistsWithPath f p = join . L.find isJust . L.map (withDistWithPath f p)  owp :: forall path -> forall sch t t'.-  (ToStar path, TabOnPath sch t path ~ t') =>-  [OrdFld sch t'] -> OrdWithPath sch t+  (ToStar (MapRenPath ren path), TabOnDPath sch t (MapRenPath ren path) ~ t') =>+  [OrdFld ren sch t'] -> OrdWithPath ren sch t owp p = OrdWithPath @p -rootOrd :: forall sch t. [OrdFld sch t] -> OrdWithPath sch t+rootOrd :: forall ren sch t. [OrdFld ren sch t] -> OrdWithPath ren sch t rootOrd = owp [] -dwp :: forall path -> forall sch t t'.-  (ToStar path, TabOnPath2 sch t path ~ '(t', 'RelMany)) =>-  Dist sch t' -> DistWithPath sch t+dwp :: forall path -> forall ren sch t t'.+  (ToStar (MapRenPath ren path), TabOnDPath2 sch t (MapRenPath ren path) ~ '(t', 'RelMany)) =>+  Dist ren sch t' -> DistWithPath ren sch t dwp p = DistWithPath @p -rootDist :: forall sch t. Dist sch t -> DistWithPath sch t+rootDist :: forall ren sch t. Dist ren sch t -> DistWithPath ren sch t rootDist = dwp [] -convPreOrd :: forall sch tab. [OrdFld sch tab] -> CondMonad [(Text, OrdDirection)]+convPreOrd :: forall ren sch tab. [OrdFld ren sch tab] -> CondMonad [(Text, OrdDirection)] convPreOrd = traverse processFld   where     processFld = \case-      OrdFld @fld od -> (, od) <$> qual @fld+      OrdFld @fld od -> (, od) <$> qual @(ApplyRenamer ren fld)       UnsafeOrd m -> m  renderOrd :: [(Text, OrdDirection)] -> TextI ","@@ -427,7 +441,7 @@   where     render (t, show' -> od) = t <> " " <> od <> " nulls last" -convOrd :: forall sch tab. [OrdFld sch tab] -> CondMonad (TextI ",")+convOrd :: forall ren sch tab. [OrdFld ren sch tab] -> CondMonad (TextI ",") convOrd = fmap renderOrd . convPreOrd  data DistTexts = DistTexts@@ -437,7 +451,7 @@   deriving Generic   deriving (Semigroup, Monoid) via (Generically DistTexts) -convDist :: forall sch tab. Dist sch tab -> CondMonad DistTexts+convDist :: forall ren sch tab. Dist ren sch tab -> CondMonad DistTexts convDist = \case   Distinct -> pure $ mempty { distinct = Any True }   DistinctOn ofs -> convPreOrd ofs <&> \xs -> mempty

@@ -4,7 +4,7 @@   -- ( QueryParam(..), qpEmpty   -- , CondWithPath(..), OrdWithPath(..), DistWithPath(..), LimOffWithPath(..)   -- , LO(..)-  -- , CondMonad, qRoot, qPath, qWhere, qOrderBy, qDistinct, qDistinctOn, qLimit, qOffset+  -- , CondMonad, qRoot, qPath, qPathFromHere, qPathToHere, qWhere, qOrderBy, qDistinct, qDistinctOn, qLimit, qOffset   -- , Cond(..), pnull, pchild, pparent, pnot, pin, pinArr, pUnsafeCond   -- , (|||), (&&&), (<?),(>?),(<=?),(>=?),(=?),(~=?),(~~?), showCmp, BoolOp(..)   -- , TabParam(..), OrdFld(..), Dist(..), defTabParam, defLO, lo1@@ -26,6 +26,7 @@ import GHC.Natural import GHC.TypeLits import GHC.TypeError qualified as TE+import PgSchema.Ann import PgSchema.Schema import PgSchema.Types import PgSchema.Utils.Internal@@ -36,25 +37,27 @@ -- -- You don't need to make it directly. Use 'MonadQP' to define 'QueryParam' instead. ---data QueryParam sch t = QueryParam-  { qpConds     :: ![CondWithPath sch t]    -- ^ `where` conditions for branches of Data-Tree-  , qpOrds      :: ![OrdWithPath sch t]     -- ^ `order by` clauses-  , qpLOs       :: ![LimOffWithPath sch t]  -- ^ `limit/offset` clauses-  , qpDistinct  :: ![DistWithPath sch t]    -- ^ `distinct` and `distinct on` clauses+data QueryParam ren sch t = QueryParam+  { qpConds     :: ![CondWithPath ren sch t]    -- ^ `where` conditions for branches of Data-Tree+  , qpOrds      :: ![OrdWithPath ren sch t]     -- ^ `order by` clauses+  , qpLOs       :: ![LimOffWithPath ren sch t]  -- ^ `limit/offset` clauses+  , qpDistinct  :: ![DistWithPath ren sch t]    -- ^ `distinct` and `distinct on` clauses   }  -- | Empty 'QueryParam'. -- -- It means that @SELECT@ is defined only by structure of output type-qpEmpty :: forall sch t. QueryParam sch t+qpEmpty :: forall ren sch t. QueryParam ren sch t qpEmpty = QueryParam [] [] [] [] -type MonadQP sch t path = (TabPath sch t path, ToStar path) => RWS (Proxy path) () (QueryParam sch t) ()+type MonadQP ren sch t path+  = (TabDPath sch t (MapRenPath ren path), ToStar (MapRenPath ren path))+  => RWS (Proxy path) () (QueryParam ren sch t) ()  -- | Execute 'MonadQP' and get 'QueryParam'. -- -- The table `t` defines a context and becomes the "current" table-qRoot :: RWS (Proxy '[]) () (QueryParam sch t) () -> QueryParam sch t+qRoot :: RWS (Proxy '[]) () (QueryParam ren sch t) () -> QueryParam ren sch t qRoot m = fst $ execRWS m Proxy qpEmpty  -- | Change context (current table) to parent or child table.@@ -62,18 +65,71 @@ -- The 'Symbol' must name the foreign-key constraint (edge to the parent or from the child) -- for the step away from the current table. ---qPath :: forall sch t path path'.-  forall (p :: Symbol) ->-  (TabPath sch t path', ToStar path', path' ~ path ++ '[p]) =>-  MonadQP sch t path' -> MonadQP sch t path-qPath _p m = do-  s <- get-  put $ fst $ execRWS m Proxy s+qPath :: forall ren sch t path path' path'' tabPath p' k. forall (p :: Symbol)+  -> PathCheck 'Nothing p ren sch t path path' path'' tabPath p' k+  => MonadQP ren sch t path' -> MonadQP ren sch t path+qPath _p m = put . fst . execRWS m Proxy =<< get +-- | Change context (current table) to parent table.+--+-- The 'Symbol' must name the foreign-key constraint (edge to the parent)+-- for the step away from the current table.+--+qPathFromHere :: forall ren sch t path path' path'' tabPath p' k. forall (p :: Symbol)+  -> PathCheck ('Just 'FromHere) p ren sch t path path' path'' tabPath p' k+  => MonadQP ren sch t path' -> MonadQP ren sch t path+qPathFromHere _p m = put . fst . execRWS m Proxy =<< get++-- | Change context (current table) to child table.+--+-- The 'Symbol' must name the foreign-key constraint (edge from the child)+-- for the step away from the current table.+--+qPathToHere :: forall ren sch t path path' path'' tabPath p' k. forall (p :: Symbol)+  -> PathCheck ('Just 'ToHere) p ren sch t path path' path'' tabPath p' k+  => MonadQP ren sch t path' -> MonadQP ren sch t path+qPathToHere _p m = put . fst . execRWS m Proxy =<< get++type family ResolvePathKind+  (pathKind :: Maybe PathKind) (hasFrom :: Bool) (hasTo :: Bool) (tab :: NameNSK) (name :: Symbol)+  :: PathKind where+    ResolvePathKind ('Just 'FromHere) 'True _ _ _ = 'FromHere+    ResolvePathKind ('Just 'ToHere) _ 'True _ _ = 'ToHere+    ResolvePathKind 'Nothing 'True 'False _ _ = 'FromHere+    ResolvePathKind 'Nothing 'False 'True _ _ = 'ToHere+    ResolvePathKind ('Just 'FromHere) _ _ tab name = TypeError+      (TE.Text "Relation is not available in from-here direction."+      :$$: TE.Text "Use qPathToHere or qPath."+      :$$: TE.Text ""+      :$$: TE.Text "Table: " :<>: ShowType tab+      :$$: TE.Text "Relation: " :<>: ShowType name+      :$$: TE.Text "" )+    ResolvePathKind ('Just 'ToHere) _ _ tab name = TypeError+      (TE.Text "Relation is not available in to-here direction."+      :$$: TE.Text "Use qPathFromHere or qPath."+      :$$: TE.Text ""+      :$$: TE.Text "Table: " :<>: ShowType tab+      :$$: TE.Text "Relation: " :<>: ShowType name+      :$$: TE.Text "" )+    ResolvePathKind 'Nothing _ _ tab name = TypeError+      (TE.Text "qPath cannot be used for self-reference relation."+      :$$: TE.Text "Use qPathFromHere or qPathToHere."+      :$$: TE.Text ""+      :$$: TE.Text "Table: " :<>: ShowType tab+      :$$: TE.Text "Relation: " :<>: ShowType name+      :$$: TE.Text "" )++type PathCheck pathKind p ren sch t path path' path'' tabPath p' k =+  ( p' ~ ApplyRenamer ren p+  , tabPath ~ TabOnDPath sch t (MapRenPath ren path)+  , k ~ ResolvePathKind pathKind (HasFromStep sch tabPath p') (HasToStep sch tabPath p') tabPath p'+  , path' ~ (path ++ '[ '(p, k)])+  , path'' ~ MapRenPath ren (path ++ '[ '(p, k)])+  , ToStar path'', TabDPath sch t path'' ) -- | Add @WHERE@ condition for the current table. -- -- If several 'qWhere' exist they are composed according to the 'Monoid' instance for 'Cond', i.e. with '(&&&)'-qWhere :: forall sch t path. Cond sch (TabOnPath sch t path) -> MonadQP sch t path+qWhere :: forall ren sch t path. Cond ren sch (TabOnDPath sch t (MapRenPath ren path)) -> MonadQP ren sch t path qWhere c = modify \qp -> qp { qpConds = CondWithPath @path c : qp.qpConds }  -- | Add @ORDER BY@ condition for the current table@@ -91,13 +147,13 @@ -- -- we get @ORDER BY t1.f1, t2.f2 DESC, t1.f3@ ---qOrderBy :: forall sch t path. [OrdFld sch (TabOnPath sch t path)] -> MonadQP sch t path+qOrderBy :: forall ren sch t path. [OrdFld ren sch (TabOnDPath sch t (MapRenPath ren path))] -> MonadQP ren sch t path qOrderBy ofs = modify \qp -> qp { qpOrds = OrdWithPath @path ofs : qp.qpOrds }  -- | Add `DISTINCT` condition for the current table. -- It is applied only to "root" or "children" tables.-qDistinct :: forall sch t path t'. TabOnPath2 sch t path ~ '(t', 'RelMany) =>-  MonadQP sch t path+qDistinct :: forall ren sch t path t'. TabOnDPath2 sch t path ~ '(t', 'RelMany) =>+  MonadQP ren sch t path qDistinct = modify \qp -> qp { qpDistinct = DistWithPath @path Distinct : qp.qpDistinct }  -- | Add @DISTINCT ON@ condition for the current table.@@ -118,21 +174,21 @@ -- -- we get @DISTINCT ON (t1.f1, t2.f2, t1.f3) ... ORDER BY t1.f1, t2.f2 DESC, t1.f3, t1.f0 DESC@ ---qDistinctOn :: forall sch t path. [OrdFld sch (TabOnPath sch t path)] -> MonadQP sch t path+qDistinctOn :: forall ren sch t path. [OrdFld ren sch (TabOnDPath sch t (MapRenPath ren path))] -> MonadQP ren sch t path qDistinctOn ofs = modify \qp -> qp { qpDistinct = DistWithPath @path (DistinctOn ofs) : qp.qpDistinct }  -- | Add `LIMIT` condition for the current table. -- It is applied only to "root" or "children" tables. -- -- If 'qLimit' is applied several times on the same path, only the last one is used-qLimit :: forall sch t path. Snd (TabOnPath2 sch t path) ~ RelMany-  => Natural -> MonadQP sch t path+qLimit :: forall ren sch t path. Snd (TabOnDPath2 sch t (MapRenPath ren path)) ~ RelMany+  => Natural -> MonadQP ren sch t path qLimit n = modify \qp -> qp { qpLOs = mk qp.qpLOs }   where     mk xs = case L.break eq xs of       (xs1, []) -> new : xs1       (xs1, x:xs2) -> xs1 <> [upd x] <> xs2-    eq (LimOffWithPath @p _) = demote @p == demote @path+    eq (LimOffWithPath @p _) = demote @(MapRenPath ren p) == demote @(MapRenPath ren path)     upd (LimOffWithPath @p lo) = LimOffWithPath @p lo{ limit = Just n }     new = LimOffWithPath @path LO { limit = Just n, offset = Nothing } @@ -140,37 +196,38 @@ -- It is applied only to "root" or "children" tables. -- -- If 'qOffset' is applied several times on the same path, only the last one is used-qOffset :: forall sch t path. Snd (TabOnPath2 sch t path) ~ RelMany-  => Natural -> MonadQP sch t path+qOffset :: forall ren sch t path. Snd (TabOnDPath2 sch t (MapRenPath ren path)) ~ RelMany+  => Natural -> MonadQP ren sch t path qOffset n = modify \qp -> qp { qpLOs = mk qp.qpLOs }   where     mk xs = case L.break eq xs of       (xs1, []) -> new : xs1       (xs1, x:xs2) -> xs1 <> [upd x] <> xs2-    eq (LimOffWithPath @p _) = demote @p == demote @path+    eq (LimOffWithPath @p _) = demote @(MapRenPath ren p) == demote @(MapRenPath ren path)     upd (LimOffWithPath @p lo) = LimOffWithPath @p lo{offset = Just n}     new = LimOffWithPath @path LO { offset = Just n, limit = Nothing }  -- | GADT to safely set `where` condition-data CondWithPath sch t where-  CondWithPath ::  forall (path :: [Symbol]) sch t. ToStar path-    => Cond sch (TabOnPath sch t path) -> CondWithPath sch t+data CondWithPath ren sch t where+  CondWithPath ::  forall (path :: [(Symbol, PathKind)]) ren sch t. ToStar (MapRenPath ren path)+    => Cond ren sch (TabOnDPath sch t (MapRenPath ren path)) -> CondWithPath ren sch t  -- | GADT to safely set `order by` clauses-data OrdWithPath sch t where-  OrdWithPath :: forall (path :: [Symbol]) sch t. ToStar path-    => [OrdFld sch (TabOnPath sch t path)] -> OrdWithPath sch t+data OrdWithPath ren sch t where+  OrdWithPath :: forall (path :: [(Symbol, PathKind)]) ren sch t. ToStar (MapRenPath ren path)+    => [OrdFld ren sch (TabOnDPath sch t (MapRenPath ren path))] -> OrdWithPath ren sch t  -- | GADT to safely set `distinct/distinct on` clauses-data DistWithPath sch t where-  DistWithPath :: forall (path :: [Symbol]) sch t. ToStar path-    => Dist sch (TabOnPath sch t path) -> DistWithPath sch t+data DistWithPath ren sch t where+  DistWithPath :: forall (path :: [(Symbol, PathKind)]) ren sch t. ToStar (MapRenPath ren path)+    => Dist ren sch (TabOnDPath sch t (MapRenPath ren path)) -> DistWithPath ren sch t  -- | GADT to safely set `limit/offset` clauses-data LimOffWithPath sch t where-  LimOffWithPath :: forall (path :: [Symbol]) sch t.-    (TabPath sch t path, ToStar path, Snd (TabOnPath2 sch t path) ~ 'RelMany)-    => LO -> LimOffWithPath sch t+data LimOffWithPath ren sch t where+  LimOffWithPath :: forall (path :: [(Symbol, PathKind)]) ren sch t.+    ( TabDPath sch t (MapRenPath ren path), ToStar (MapRenPath ren path)+    , Snd (TabOnDPath2 sch t (MapRenPath ren path)) ~ 'RelMany )+    => LO -> LimOffWithPath ren sch t  -- | Comparison constructors; each is paired with its corresponding operator -- (e.g. '(:=)' with '(=?)').@@ -239,42 +296,45 @@ -- -- 'Cond' is 'Monoid' with conjunction ('(&&&)') as 'mappend' ---data Cond (sch::Type) (tab::NameNSK) where-  EmptyCond :: Cond sch tab+data Cond (ren :: Renamer) (sch::Type) (tab::NameNSK) where+  EmptyCond :: Cond ren sch tab   -- ^ Empty Condition. Neutral for conjunction '(&&&)' and disjunction '(|||)'.-  Cmp :: forall fld v sch tab. CDBValue sch tab fld v => Cmp -> v -> Cond sch tab+  Cmp :: forall fld v ren sch tab. CDBValue sch tab (ApplyRenamer ren fld) v => Cmp -> v -> Cond ren sch tab   -- ^ Comparing field value with parameter-  In :: forall fld v sch tab. CDBValue sch tab fld v => NonEmpty v -> Cond sch tab+  In :: forall fld v ren sch tab. CDBValue sch tab (ApplyRenamer ren fld) v => NonEmpty v -> Cond ren sch tab   -- ^ Check that field value belongs to non-empty list of values-  InArr :: forall fld v sch tab. CDBValue sch tab fld v => [v] -> Cond sch tab+  InArr :: forall fld v ren sch tab. CDBValue sch tab (ApplyRenamer ren fld) v => [v] -> Cond ren sch tab   -- ^ Check that field value belongs to the list of values.   -- If the list is empty, the condition evaluates to @false@.-  Null :: forall fld sch tab. CDBFieldNullable sch tab fld => Cond sch tab+  Null :: forall fld ren sch tab.+    CDBFieldNullable sch tab (ApplyRenamer ren fld) => Cond ren sch tab   -- ^ Check that field value is @NULL@-  Not :: Cond sch tab -> Cond sch tab+  Not :: Cond ren sch tab -> Cond ren sch tab   -- ^ Boolean @NOT@-  BoolOp :: BoolOp -> Cond sch tab -> Cond sch tab -> Cond sch tab+  BoolOp :: BoolOp -> Cond ren sch tab -> Cond ren sch tab -> Cond ren sch tab   -- ^ Conjunction and disjunction-  Child :: forall sch ref. CRelDef sch ref =>-    TabParam sch (RdFrom (TRelDef sch ref)) -> Cond sch (RdFrom (TRelDef sch ref))-    -> Cond sch (RdTo (TRelDef sch ref))+  Child :: forall ren sch ref. CRelDef sch (ApplyRenamerNS ren ref)+    => TabParam ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))+    -> Cond ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))+    -> Cond ren sch (RdTo (TRelDef sch (ApplyRenamerNS ren ref)))   -- ^ condition @EXISTS@ in child table. 'TabParam' is used to limit   -- child dataset (usually with @ORDER BY@ and @LIMIT@) before applying   -- condition on child table-  Parent :: forall sch ref . CRelDef sch ref =>-    Cond sch (RdTo (TRelDef sch ref)) -> Cond sch (RdFrom (TRelDef sch ref))+  Parent :: forall ren sch ref . CRelDef sch (ApplyRenamerNS ren ref)+    => Cond ren sch (RdTo (TRelDef sch (ApplyRenamerNS ren ref)))+    -> Cond ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))   -- ^ @JOIN@ to parent rows that satisfy the nested condition-  UnsafeCond :: CondMonad Text -> Cond sch tab+  UnsafeCond :: CondMonad Text -> Cond ren sch tab   -- ^ Unsafe condition built manually inside 'CondMonad'  -- Conjunction '(&&&)' is much more often operation for query conditions so -- we use it for 'Semigroup'. -- But note that 'EmptyCond' is also neutral for disjunction '(|||)'.-instance Semigroup (Cond sch tab) where+instance Semigroup (Cond ren sch tab) where   c1 <> c2 = c1 &&& c2   -- ^ Using conjunction ('(&&&)') for 'Semigroup' instance -instance Monoid (Cond sch tab) where+instance Monoid (Cond ren sch tab) where   mempty = EmptyCond  -- | Parameters for child table.@@ -282,18 +342,18 @@ -- It is used to limit child dataset (usually with @ORDER BY@ and @LIMIT@) before applying -- condition on child table ---data TabParam sch tab = TabParam-  { cond :: Cond sch tab-  , order :: [OrdFld sch tab]+data TabParam ren sch tab = TabParam+  { cond :: Cond ren sch tab+  , order :: [OrdFld ren sch tab]   , lo :: LO }  -- | Default empty 'TabParam'.-defTabParam :: TabParam sch tab+defTabParam :: TabParam ren sch tab defTabParam = TabParam mempty mempty defLO  -- | Check that field value is @NULL@ {-# INLINE pnull #-}-pnull :: forall sch tab. forall name -> CDBFieldNullable sch tab name => Cond sch tab+pnull :: forall ren sch tab. forall name -> CDBFieldNullable sch tab (ApplyRenamer ren name) => Cond ren sch tab pnull name = Null @name  -- | True when related rows exist in the child table and satisfy the nested condition there@@ -302,43 +362,45 @@ -- condition on child table -- {-# INLINE pchild #-}-pchild :: forall sch . forall ref -> CRelDef sch ref =>-  TabParam sch (RdFrom (TRelDef sch ref)) -> Cond sch (RdFrom (TRelDef sch ref))-  -> Cond sch (RdTo (TRelDef sch ref))-pchild name = Child @sch @name+pchild :: forall ren sch . forall ref -> CRelDef sch (ApplyRenamerNS ren ref)+  => TabParam ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))+  -> Cond ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))+  -> Cond ren sch (RdTo (TRelDef sch (ApplyRenamerNS ren ref)))+pchild name = Child @ren @sch @name  -- | Check that condition is satisfied in parent table {-# INLINE pparent #-}-pparent :: forall sch. forall ref -> CRelDef sch ref =>-  Cond sch (RdTo (TRelDef sch ref)) -> Cond sch (RdFrom (TRelDef sch ref))-pparent name = Parent @sch @name+pparent :: forall ren sch. forall ref -> CRelDef sch (ApplyRenamerNS ren ref)+  => Cond ren sch (RdTo (TRelDef sch (ApplyRenamerNS ren ref)))+  -> Cond ren sch (RdFrom (TRelDef sch (ApplyRenamerNS ren ref)))+pparent name = Parent @ren @sch @name  -- | Boolean @NOT@ {-# INLINE pnot #-}-pnot :: Cond sch tab -> Cond sch tab+pnot :: Cond ren sch tab -> Cond ren sch tab pnot = Not  {-# INLINE pUnsafeCond #-}-pUnsafeCond :: CondMonad Text -> Cond sch tab+pUnsafeCond :: CondMonad Text -> Cond ren sch tab pUnsafeCond = UnsafeCond  -- | Check that field value belongs to non-empty list of values {-# INLINE pin #-}-pin :: forall name -> forall sch tab v. CDBValue sch tab name v-  => NonEmpty v -> Cond sch tab+pin :: forall name -> forall ren sch tab v. CDBValue sch tab (ApplyRenamer ren name) v+  => NonEmpty v -> Cond ren sch tab pin name = In @name  -- | Check that field value belongs to the list of values. -- If the list is empty, the condition evaluates to @false@. {-# INLINE pinArr #-}-pinArr :: forall name -> forall sch tab v. CDBValue sch tab name v-  => [v] -> Cond sch tab+pinArr :: forall name -> forall ren sch tab v. CDBValue sch tab (ApplyRenamer ren name) v+  => [v] -> Cond ren sch tab pinArr name = InArr @name  -- | Conjunction-(&&&) :: Cond sch tab -> Cond sch tab -> Cond sch tab+(&&&) :: Cond ren sch tab -> Cond ren sch tab -> Cond ren sch tab -- | Disjunction-(|||) :: Cond sch tab -> Cond sch tab -> Cond sch tab+(|||) :: Cond ren sch tab -> Cond ren sch tab -> Cond ren sch tab EmptyCond &&& cond = cond cond &&& EmptyCond = cond c1 &&& c2 = BoolOp And c1 c2@@ -356,27 +418,27 @@ {-# INLINE (~=?) #-} {-# INLINE (~~?) #-} (<?),(>?),(<=?),(>=?),(=?)-   :: forall fld -> forall sch tab v. CDBValue sch tab fld v => v -> Cond sch tab+   :: forall fld -> forall ren sch tab v. CDBValue sch tab (ApplyRenamer ren fld) v => v -> Cond ren sch tab x <? b  = Cmp @x (:<)  b x >? b  = Cmp @x (:>)  b x <=? b = Cmp @x (:<=) b x >=? b = Cmp @x (:>=) b x =? b = Cmp @x (:=) b (~=?),(~~?)-  :: forall fld -> forall sch tab v. CDBValue sch tab fld v => v -> Cond sch tab+  :: forall fld -> forall ren sch tab v. CDBValue sch tab (ApplyRenamer ren fld) v => v -> Cond ren sch tab x ~=? b  = Cmp @x Like b x ~~? b  = Cmp @x ILike b infix 4 <?, >?, <=?, >=?, =?, ~=?, ~~?  data OrdDirection = Asc | Desc deriving Show -data OrdFld sch tab where-  OrdFld :: forall fld sch tab. CDBField sch tab fld =>-    OrdDirection -> OrdFld sch tab-  UnsafeOrd :: CondMonad (Text, OrdDirection) -> OrdFld sch tab+data OrdFld ren sch tab where+  OrdFld :: forall fld ren sch tab. CDBField sch tab (ApplyRenamer ren fld) =>+    OrdDirection -> OrdFld ren sch tab+  UnsafeOrd :: CondMonad (Text, OrdDirection) -> OrdFld ren sch tab -data Dist sch tab where-  Distinct :: Dist sch tab+data Dist ren sch tab where+  Distinct :: Dist ren sch tab   -- | Having 'DistinctOn' we automatically add fields from 'DistinctOn'   -- into the begining of @ORDER BY@.   -- (It is "good enough" and more simple than check it on type level).@@ -386,20 +448,22 @@   --   -- Beside that @DISTINCT ON@ part can include expressions like @ORDER BY@.   -- We can also use 'UnsafeOrd' here-  DistinctOn :: [OrdFld sch tab] -> Dist sch tab+  DistinctOn :: [OrdFld ren sch tab] -> Dist ren sch tab  {-# INLINE ordf #-} ordf-  :: forall fld -> forall sch tab. CDBField sch tab fld-  => OrdDirection -> OrdFld sch tab+  :: forall fld -> forall sch tab. CDBField sch tab (ApplyRenamer ren fld)+  => OrdDirection -> OrdFld ren sch tab ordf fld = OrdFld @fld  {-# INLINE ascf #-}-ascf :: forall fld -> forall sch tab. CDBField sch tab fld => OrdFld sch tab+ascf :: forall fld -> forall sch tab. CDBField sch tab (ApplyRenamer ren fld)+  => OrdFld ren sch tab ascf fld = ordf fld Asc  {-# INLINE descf #-}-descf :: forall fld -> forall sch tab. CDBField sch tab fld => OrdFld sch tab+descf :: forall fld -> forall sch tab. CDBField sch tab (ApplyRenamer ren fld)+  => OrdFld ren sch tab descf fld = ordf fld Desc  data LO = LO

@@ -20,8 +20,8 @@  -- | Update rows matching a condition; the result type selects which columns are returned. updateByCond :: forall ann -> forall r r'.-  (ann ~ 'Ann ren sch d t, UpdateReturning ann r r') =>-  Connection -> r -> Cond sch t -> IO [r']+  (UpdateReturning ann r r') =>+  Connection -> r -> Cond (AnnRen ann) (AnnSch ann) (AnnTab ann) -> IO [r'] updateByCond ann @r @r' conn r (updateText ann @r @r' -> (q,ps)) =   trace' (q <> "\n\n" <> P.show ps <> "\n\n")   $ fmap (fmap (unPgTag @ann @r'))@@ -29,9 +29,8 @@   $ PgTag @ann @r r :. ps  -- | Update records by condition without @RETURNING@.-updateByCond_ :: forall ann -> forall r.-  (ann ~ 'Ann ren sch d t, UpdateNonReturning ann r) =>-  Connection -> r -> Cond sch t -> IO Int64+updateByCond_ :: forall ann -> forall r. UpdateNonReturning ann r =>+  Connection -> r -> Cond (AnnRen ann) (AnnSch ann) (AnnTab ann) -> IO Int64 updateByCond_ ann @r conn r (updateText_ ann @r -> (q, ps)) =   trace' (q <> "\n\n" <> P.show ps <> "\n\n")   $ execute conn (fromString q)@@ -39,8 +38,8 @@  -- | Construct SQL text for updating records by condition and returning some fields. updateText :: forall ann -> forall r r' s.-  (CRecInfo ann r, CRecInfo ann r', IsString s, Monoid s, ann ~ 'Ann ren sch d t)-  => Cond sch t -> (s, [SomeToField])+  (CRecInfo ann r, CRecInfo ann r', IsString s, Monoid s)+  => Cond (AnnRen ann) (AnnSch ann) (AnnTab ann) -> (s, [SomeToField]) updateText ann @r @r' (updateText_ ann @r -> (q, p)) = (q <> " returning " <> fs', p)   where     ri' = getRecordInfo @ann @r'@@ -49,7 +48,7 @@ -- | Construct SQL text for updating records by condition without @RETURNING@. updateText_   :: forall ann -> forall r s. (IsString s, Monoid s, CRecInfo ann r)-  => Cond sch t -> (s, [SomeToField])+  => Cond ren sch t -> (s, [SomeToField]) updateText_ ann @r (pgCond 0 -> (condTxt, condParams)) =   ("update " <> tn <> " t0 set " <> fs <> fromText whereTxt, condParams )   where

@@ -72,11 +72,11 @@ type AnnCat tn = 'Ann RenamerId PgCatalog 3 (PGC tn)  selCat :: forall (tn :: Symbol) -> forall r. (Selectable (AnnCat tn) r)-  => Connection -> QueryParam PgCatalog (PGC tn) -> IO ([r], (Text,[SomeToField]))+  => Connection -> QueryParam RenamerId PgCatalog (PGC tn) -> IO ([r], (Text,[SomeToField])) selCat tn = selectSch (AnnCat tn)  selTxt :: forall (tn :: Symbol) -> forall r. (Selectable (AnnCat tn) r)-  => QueryParam PgCatalog (PGC tn) -> (Text,[SomeToField])+  => QueryParam RenamerId PgCatalog (PGC tn) -> (Text,[SomeToField]) selTxt tn @r = selectText (AnnCat tn) @r  getSchema@@ -114,11 +114,11 @@           pure $ pgArr' $ fromIntegral . (+1) <$> inds  -- all data are ordered to provide stable `hashSchema`-    qpTyp = qRoot @PgCatalog @(PGC "pg_type") do+    qpTyp = qRoot do       qOrderBy [ascf "typname", ordNS "typnamespace"]       qPath "enum__type" do         qOrderBy [ascf "enumsortorder"]-    qpClass = qRoot @PgCatalog @(PGC "pg_class") do+    qpClass = qRoot do       qWhere $ condClass &&& pin "relkind" (PgChar <$> 'v' :| "r") -- views & tables       qOrderBy [ascf "relname", ordNS "relnamespace"]       qPath "attribute__class" do@@ -126,7 +126,7 @@         qOrderBy [ascf "attnum"]       qPath "constraint__class" do         qOrderBy [ascf "conname"]-    qpRel = qRoot @PgCatalog @(PGC "pg_constraint") do+    qpRel = qRoot do       qWhere         $   pparent (PGC "constraint__class") condClass         ||| pparent (PGC "constraint__fclass") condClass@@ -234,6 +234,7 @@   -> GenNames -- ^ names of schemas in database or tables to generate   -> IO Bool updateSchemaFile verbose fileName ecs moduleName schName genNames = do+  getCurrentDirectory >>= print   connStr <- either getConnStr pure ecs   if BS.null connStr     then pure False

@@ -11,7 +11,7 @@ import Data.Text as T hiding (show) import Data.Type.Bool import Data.Type.Equality-import GHC.TypeLits+import GHC.TypeLits as TL import PgSchema.Utils.Instances() import PgSchema.Utils.Internal import PgSchema.Utils.TF@@ -58,6 +58,9 @@ -- | Cardinality of a relation edge (one vs many from this table’s perspective). data RelType = RelOne | RelMany deriving Show +-- | Direction of one path step relative to the current table.+data PathKind = FromHere | ToHere deriving (Show, Eq)+ -- | Field of a logical record: plain column, aggregate, or relation hop. data RecField' s p   = RFEmpty s -- ^ Placeholder / unnamed slot (depending on schema codegen).@@ -65,6 +68,9 @@   | RFAggr (FldDef' s) AggrFun Bool     -- ^ Aggregate field: 'FldDef'', which aggregate, and whether it is allowed outside @GROUP BY@     -- (when 'True': any select; when 'False': only with @GROUP BY@).+  | RFUnsafe [s] s+  -- ^ Plain field that we get as expression. E.g. @RFUnsafe ["a", "b"] "? + ?"@+  -- means @tn.a + tn.b@ in query   | RFToHere p [Ref' s]     -- ^ Relation: navigate @p@ toward the current table (“to here”).   | RFFromHere p [Ref' s]@@ -82,6 +88,7 @@  genSingletons   [ ''AggrFun, ''NameNS', ''TypDef', ''FldDef', ''TabDef', ''RelDef', ''RelType+  , ''PathKind   , ''RecField', ''Ref' ]  type NameNSK = NameNS' Symbol@@ -273,6 +280,16 @@   (Map2 (TRelDefSym1 sch) (TFrom sch t)) (Map2 (TRelDefSym1 sch) (TTo sch t))   name +type family GetRelDef (rels :: [(NameNSK, RelDefK)]) (s :: Symbol) :: RelDefK where+  GetRelDef '[] s = TypeError ('Text "No relation by name" ':$$: 'ShowType s)+  GetRelDef ('(a, b) ': xs) s = If (NnsName a == s) b (GetRelDef xs s)++type family TRelFromTab sch t name :: NameNSK where+  TRelFromTab sch t name = RdTo (GetRelDef (Map2 (TRelDefSym1 sch) (TFrom sch t)) name)++type family TRelToTab sch t name :: NameNSK where+  TRelToTab sch t name = RdFrom (GetRelDef (Map2 (TRelDefSym1 sch) (TTo sch t)) name)+ type family TabOnPath2 sch (t :: NameNSK) (path :: [Symbol]) :: (NameNSK, RelType) where   TabOnPath2 sch t '[] = '(t, 'RelMany)   TabOnPath2 sch t '[x] = TRelTab sch t x@@ -285,9 +302,29 @@   TabPath sch t '[] = ()   TabPath sch t (x ': xs) = TabPath sch (Fst (TRelTab sch t x)) xs +type family TabOnDPath2 sch (t :: NameNSK) (path :: [(Symbol, PathKind)]) :: (NameNSK, RelType) where+  TabOnDPath2 sch t '[] = '(t, 'RelMany)+  TabOnDPath2 sch t '[ '(name, 'FromHere)] = '(TRelFromTab sch t name, 'RelOne)+  TabOnDPath2 sch t '[ '(name, 'ToHere)] = '(TRelToTab sch t name, 'RelMany)+  TabOnDPath2 sch t ('(name, 'FromHere) ': xs) = TabOnDPath2 sch (TRelFromTab sch t name) xs+  TabOnDPath2 sch t ('(name, 'ToHere) ': xs) = TabOnDPath2 sch (TRelToTab sch t name) xs++type family TabOnDPath sch (t :: NameNSK) (path :: [(Symbol, PathKind)]) :: NameNSK where+  TabOnDPath sch t path = Fst (TabOnDPath2 sch t path)++type family TabDPath sch (t :: NameNSK) (path :: [(Symbol, PathKind)]) :: Constraint where+  TabDPath sch t '[] = ()+  TabDPath sch t ('(name, 'FromHere) ': xs) = TabDPath sch (TRelFromTab sch t name) xs+  TabDPath sch t ('(name, 'ToHere) ': xs) = TabDPath sch (TRelToTab sch t name) xs+ type RecField = RecField' Text type Ref = Ref' Text +type family HasNullableRefs (rs :: [RefK]) :: Bool where+  HasNullableRefs '[] = 'False+  HasNullableRefs ('Ref _ ('FldDef _ 'True  _) _ _ ': rs) = 'True+  HasNullableRefs ('Ref _ ('FldDef _ 'False _) _ _ ': rs) = HasNullableRefs rs+ -- | Value-level: whether any ref in the list has a nullable column. -- Companion to type-level 'HasNullableRefs'. hasNullableRefs :: [Ref] -> Bool@@ -297,3 +334,38 @@ qualName NameNS {..}   | nnsNamespace == fromString "pg_catalog" = nnsName   | otherwise = nnsNamespace <> fromString "." <> nnsName++type family HasRelName (rels :: [NameNSK]) (name :: Symbol) :: Bool where+  HasRelName '[] name = 'False+  HasRelName ('NameNS nns name ': rs) name = 'True+  HasRelName (_ ': rs) name = HasRelName rs name++type HasFromStep sch tab name = HasRelName (TFrom sch tab) name+type HasToStep   sch tab name = HasRelName (TTo sch tab) name++type family CheckStep (pathKind :: (Maybe PathKind)) (hasFrom :: Bool) (hasTo :: Bool) sch tab name :: Constraint where+  CheckStep ('Just FromHere) 'True _ sch tab name = ()+  CheckStep ('Just 'ToHere)   _ 'True sch tab name = ()+  CheckStep 'Nothing 'True 'False sch tab name = ()+  CheckStep 'Nothing 'False 'True sch tab name = ()+  CheckStep ('Just 'FromHere) _ _ sch tab name = TypeError+    ( TL.Text "Relation is not available in from-here direction."+    :$$: TL.Text "Use qPathToHere or qPath."+    :$$: TL.Text ""+    :$$: TL.Text "Table: " :<>: ShowType tab+    :$$: TL.Text "Relation: " :<>: ShowType name+    :$$: TL.Text "" )+  CheckStep ('Just 'ToHere) _ _ sch tab name = TypeError+    ( TL.Text "Relation is not available in to-here direction."+    :$$: TL.Text "Use qPathFromHere or qPath."+    :$$: TL.Text ""+    :$$: TL.Text "Table: " :<>: ShowType tab+    :$$: TL.Text "Relation: " :<>: ShowType name+    :$$: TL.Text "" )+  CheckStep 'Nothing _ _ sch tab name = TypeError+    ( TL.Text "qPath cannot be used for self-reference relation."+    :$$: TL.Text "Use qPathFromHere or qPathToHere."+    :$$: TL.Text ""+    :$$: TL.Text "Table: " :<>: ShowType tab+    :$$: TL.Text "Relation: " :<>: ShowType name+    :$$: TL.Text "" )

@@ -12,7 +12,9 @@   -- * Other types   , PgChar(..), PgOid(..)   -- * Conversion checks-  , CanConvert, CanConvert1)+  , CanConvert, CanConvert1+  -- * UnsafeCol+  , UnsafeCol(..) )   where  import Control.Monad@@ -316,6 +318,9 @@ type instance CanConvert1 sch tab fld tn ('TypDef "A" ('Just n) y) (PgArr t) =   CanConvert1 sch tab fld n (TTypDef sch n) t +type instance CanConvert1 sch tab fld tn ('TypDef "A" ('Just n) y) (PgTag ('Just n) (PgArr t)) =+  CanConvert1 sch tab fld n (TTypDef sch n) t+ type instance CanConvert1 sch tab fld tn ('TypDef "B" x y) Bool = () type instance CanConvert1 sch tab fld (PGC "int2") ('TypDef "N" x y) Int16 = () type instance CanConvert1 sch tab fld (PGC "int4") ('TypDef "N" x y) Int32 = ()@@ -389,3 +394,39 @@ (=:) :: forall b. forall a -> b -> a := b (=:) _ = coerce infixr 5 =:++newtype UnsafeCol (flds :: [Symbol]) (expr :: Symbol) res = UnsafeCol+  { getUnsafeCol :: res }+  -- deriving newtype (FromField, FromJSON)++instance (FromField res, AllFields sch tab flds, CheckExpr flds expr) =>+  FromField (PgTag '(sch, tab :: NameNSK) (UnsafeCol flds expr res)) where+  fromField = (fmap (PgTag . UnsafeCol) .) . fromField++type CheckExpr flds expr = CheckExprInternal flds (UnconsSymbol expr)++type family CheckExprInternal flds (m :: Maybe (Char, Symbol)) :: Constraint where+  CheckExprInternal '[] 'Nothing = ()+  CheckExprInternal (x ': xs) 'Nothing = TypeError (TL.Text "Count of field names in the list of fields is more then count of question marks in expression." )+  CheckExprInternal '[] ('Just '( '?', _)) = TypeError (TL.Text "Count of question marks in expression is more then count of field names in the list of fields." )+  CheckExprInternal (x ': xs) ('Just '( '?', s)) = CheckExprInternal xs (UnconsSymbol s)+  CheckExprInternal xs ('Just '( _, s)) = CheckExprInternal xs (UnconsSymbol s)++-- >>> :kind! CheckExpr '["a", "b"] "? + ?"+-- CheckExpr '["a", "b"] "? + ?" :: Constraint+-- = () :: Constraint++type family AllFields sch tab flds :: Constraint where+  AllFields sch tab '[] = ()+  AllFields sch tab (fld ': flds) = (AllFields sch tab flds, CDBFieldInfo sch tab fld)+++instance (Show res, ToStar expr, ToStar flds) => Show (UnsafeCol flds expr res) where+  show (UnsafeCol res) = "UnsafeCol ["+    <> T.unpack (intercalate' "," $ ("'"<>) . (<>"'") <$> (demote @flds)) <> "] '"+    <> T.unpack (demote @expr) <> "' " <> P.show res++-- instance FromField++-- >>> P.show (UnsafeCol @["a","b"] @"? + ?" @Int 5)+-- "UnsafeCol ['a','b'] '? + ?' 5"

@@ -56,9 +56,13 @@     RFEmpty s     -> "'RFEmpty " <> showType s     RFPlain fd    -> "'RFPlain " <> showType fd     RFAggr fd fn b -> "'RFAggr " <> T.intercalate " " [showType fd, showType fn, showType b]+    RFUnsafe ps expr -> "'RFUnsafe " <> showType ps <> " " <> showType expr     RFToHere t rr -> "'RFToHere " <> showType t <> " " <> showType rr     RFFromHere t rr -> "'RFFromHere " <> showType t <> " " <> showType rr     RFSelfRef t rr -> "'RFSelfRef " <> showType t <> " " <> showType rr++-- >>> showType (RFUnsafe ["a", "b"] "foo ? bar ? baz" :: RecField NameNS)+-- "'RFUnsafe '[ \"a\",\"b\" ] \"foo ? bar ? baz\""  instance ShowType AggrFun where   showType = \case

@@ -101,7 +101,7 @@       """      putStrLn "Running generator..."-    void $ updateSchemaFile False "pg-schema/test-pgs/Sch.hs" (Right connStr)+    void $ updateSchemaFile False "test-pgs/Sch.hs" (Right connStr)       "Sch" -- ^ haskell module name to generate       "Sch" -- ^ name of generated haskell type for schema       (GenNames ["test_pgs"] [] []) -- ^ name of schemas in database

@@ -31,8 +31,8 @@       , testProperty "Insert/Upsert/Select root with children (composite FK)" $ prop_hier_insert_composite_fk pool       , testProperty "Select child with parent (RFFromHere)" $ prop_hier_select_child_with_parent pool       , testProperty "Duplicate field names in root and nested structure" $ prop_hier_duplicate_names_root_nested pool-      , testProperty "Optional parent FK on root (dim_a_id)" $-          prop_hier_insert_optional_parent_dim_a pool+      -- , testProperty "Optional parent FK on root (dim_a_id)" $+      --     prop_hier_insert_optional_parent_dim_a pool       ]     , testGroup "Query (test_dml)"       [ testProperty "'Simple' queries" $ prop_cond_query pool

@@ -31,13 +31,7 @@  type DimRec = "name" := Text --- | Plain root row for insertSch: mandatory fields, optional @dim_a_id@ / @dim_b_id@.-type RootPlainDimA =-  "code" := Text-  :. "grp" := Int32-  :. "name" := Text-  :. "dim_a_id" := Maybe Int32-  :. "dim_b_id" := Maybe Int32+type DimWithRoots = DimRec :. "root_dim_a_fk" := [RootRec]  type Mid1Rec =   "flag" := Bool :. "pos" := Int32 :. "sortKey" := Int32 :. "payload" := Maybe Text@@ -84,43 +78,35 @@ rootKey :: RootRec -> (Text, Int32) rootKey (c :. g :. _ :. _) = (coerce c, coerce g) --- | Nullable FK @dim_a_id@ (optional link to @dim@); plain @insSch@ because @insertJSON@--- lacks working @ToJSON@ for @Maybe (PgTag …)@ on Generic records here.-prop_hier_insert_optional_parent_dim_a :: Pool Connection -> Property-prop_hier_insert_optional_parent_dim_a pool = withTests 30 $ property do-  rootsIn <- forAll (L.nubBy eqRoot <$> genData' RootRec 1 80)-  useDim <- forAll (Gen.list (Range.linear (length rootsIn) (length rootsIn)) Gen.bool)-  dimOut <- forAll (genData' DimRec 1 30)-  outSel <- evalIO $ withPool pool \conn -> do-    delByCond "root" conn mempty-    delByCond "dim" conn mempty-    void $ insSch_ "dim" conn (dimOut :: [DimRec])-    (dimRows, _) <- selSch "dim" conn qpEmpty-    let dimIds =-          (dimRows :: ["id" := Int32 :. DimRec]) <&> \(i :. _) -> coerce i :: Int32-        plainIns :: [RootPlainDimA]-        plainIns =-          zipWith3-            (\(c :. g :. n :. _) wantDim k ->-              "code" =: coerce c-                :. "grp" =: coerce g-                :. "name" =: coerce n-                :. "dim_a_id"-                =: (if wantDim then Just (dimIds !! (k `mod` length dimIds)) else Nothing)-                :. "dim_b_id" =: Nothing)-            rootsIn-            useDim-            [(0 :: Int) ..]-    void $ insSch_ "root" conn plainIns-    (xs, _) <- selSch "root" conn qpEmpty-    pure (xs :: ["id" := Int32 :. "dim_a_id" := Maybe Int32 :. RootRec :. "root_dim_a_fk" := Maybe DimRec])-  let-    expected =-      L.sortOn (rootKey . fst) $ zip rootsIn useDim <&> \(r, u) -> (r, u)-    got =-      L.sortOn (rootKey . \(_ :. _ :. r :. _) -> r) outSel-        <&> \(_ :. PgTag dimA :. r :. _) -> (r, isJust dimA)-  expected === got+-- -- | Nullable FK @dim_a_id@: some roots come via @dim.root_dim_a_fk@ (insertJSON),+-- -- while the rest are inserted as plain roots without @dim@.+-- prop_hier_insert_optional_parent_dim_a :: Pool Connection -> Property+-- prop_hier_insert_optional_parent_dim_a pool = withTests 30 $ property do+--   rootsIn <- forAll (L.nubBy eqRoot <$> genData' RootRec 1 80)+--   withDim <- forAll (Gen.list (Range.linear (length rootsIn) (length rootsIn)) Gen.bool)+--   dimOne <- forAll (defGen :: Gen DimRec)+--   let+--     rootsWithDim = [r | (r, True) <- zip rootsIn withDim]+--     rootsNoDim = [r | (r, False) <- zip rootsIn withDim]+--   outSel <- evalIO $ withPool pool \conn -> do+--     delByCond "root" conn mempty+--     delByCond "dim" conn mempty+--     if null rootsWithDim+--       then pure ()+--       else void $ insJSON_ "dim" conn+--         [dimOne :. "root_dim_a_fk" =: rootsWithDim]+--     if null rootsNoDim+--       then pure ()+--       else void $ insJSON_ "root" conn rootsNoDim+--     (xs, _) <- selSch "root" conn qpEmpty+--     pure (xs :: ["id" := Int32 :. "dim_a_id" := Maybe Int32 :. RootRec :. "root_dim_a_fk" := Maybe DimRec])+--   let+--     expected =+--       L.sortOn (rootKey . fst) $ zip rootsIn withDim <&> \(r, u) -> (r, u)+--     got =+--       L.sortOn (rootKey . \(_ :. _ :. r :. _) -> r) outSel+--         <&> \(_ :. PgTag dimA :. r :. _) -> (r, isJust dimA)+--   expected === got  prop_hier_insert_simple_fk :: Pool Connection -> Property prop_hier_insert_simple_fk pool = withTests 30 $ property do

@@ -66,21 +66,21 @@ insSch_ tn = insertSch_ (AnnSch tn)  selSch :: forall tn -> forall r. Selectable (AnnSch tn) r-  => Connection -> QueryParam Sch (TS tn) -> IO ([r], (Text,[SomeToField]))+  => Connection -> QueryParam RenamerSch Sch (TS tn) -> IO ([r], (Text,[SomeToField])) selSch tn = selectSch (AnnSch tn)  updByCond_   :: forall tn -> forall r. UpdateNonReturning (AnnSch tn) r-  => Connection -> r -> Cond Sch (TS tn) -> IO Int64+  => Connection -> r -> Cond RenamerSch Sch (TS tn) -> IO Int64 updByCond_ tn = updateByCond_ (AnnSch tn)  updByCond :: forall tn -> forall r r'. UpdateReturning (AnnSch tn) r r'-  => Connection -> r -> Cond Sch (TS tn) -> IO [r']+  => Connection -> r -> Cond RenamerSch Sch (TS tn) -> IO [r'] updByCond tn = updateByCond (AnnSch tn)  delByCond :: forall tn -> ToStar tn-  => Connection -> Cond Sch (TS tn) -> IO (Int64, (Text,[SomeToField]))-delByCond tn = deleteByCond Sch (TS tn)+  => Connection -> Cond RenamerSch Sch (TS tn) -> IO (Int64, (Text,[SomeToField]))+delByCond tn = deleteByCond RenamerSch Sch (TS tn)  insJSON_   :: forall tn -> forall r. (InsertTreeNonReturning (AnnSch tn) r)