diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,13 @@ # Changelog for pg-schema -## Unreleased changes +## 0.5.1.1 + +- Improve error messaging + +## 0.5.1.0 + +- Bug fixing (TF stucks in some cases) + +## 0.5.0.0 + +- First releas on Hackage diff --git a/pg-schema.cabal b/pg-schema.cabal --- a/pg-schema.cabal +++ b/pg-schema.cabal @@ -1,6 +1,6 @@ cabal-version: 3.12 name: pg-schema -version: 0.5.1.0 +version: 0.5.1.1 category: Database author: Dmitry Olshansky maintainer: olshanskydr@gmail.com diff --git a/src/PgSchema/DML/Select/Types.hs b/src/PgSchema/DML/Select/Types.hs --- a/src/PgSchema/DML/Select/Types.hs +++ b/src/PgSchema/DML/Select/Types.hs @@ -22,11 +22,12 @@ import Data.String import Data.Text(Text) import Database.PostgreSQL.Simple.ToField -import PgSchema.Schema -import PgSchema.Types import GHC.Generics import GHC.Natural import GHC.TypeLits +import GHC.TypeError qualified as TE +import PgSchema.Schema +import PgSchema.Types import PgSchema.Utils.Internal import PgSchema.Utils.TF @@ -207,15 +208,33 @@ instance ToField SomeToField where toField (SomeToField v) = toField v -type CDBField sch tab fld fd = (CDBFieldInfo sch tab fld - , TDBFieldInfo sch tab fld ~ 'RFPlain fd ) +type CDBField sch tab fld = + (CDBField' sch tab fld (TDBFieldInfo sch tab fld), CDBFieldInfo sch tab fld) -type CDBValue sch tab fld fd v = - (CDBField sch tab fld fd, ToField v, Show v, CanConvert sch tab fld fd v) +type family CDBField' sch tab fld fi :: Constraint where + CDBField' sch tab fld ('RFPlain fd) = () + CDBField' sch tab fld fi = TypeError + (TE.Text "Field " :<>: ShowType fld :<>: TE.Text" is not found in table " :<>: ShowType tab + :$$: TE.Text "Schema: " :<>: ShowType sch + :$$: TE.Text "") -type CDBFieldNullable sch tab fld fd = - ( CDBField sch tab fld fd, FdNullable fd ~ 'True) +-- type CDBValue sch tab fld fd v = +-- (CDBField sch tab fld fd, ToField v, Show v, CanConvert sch tab fld fd v) +type CDBValue sch tab fld v = + (CDBValue' sch tab fld (TDBFieldInfo sch tab fld) v, CDBFieldInfo sch tab fld + , ToField v, Show v) + +type family CDBValue' sch tab fld fi v where + CDBValue' sch tab fld ('RFPlain fd) v = (CanConvert sch tab fld fd v) + CDBValue' sch tab fld fi v = TypeError + (TE.Text "Field " :<>: ShowType fld :<>: TE.Text" is not found in table " :<>: ShowType tab + :$$: TE.Text "Schema: " :<>: ShowType sch + :$$: TE.Text "") + +type CDBFieldNullable sch tab fld = + ( CDBField sch tab fld , FdNullable (GetFldDef sch tab fld) ~ 'True) + -- | GADT to safely set `where` condition for table `tab` based on definition of schema `sch` -- -- 'Cond' is 'Monoid' with conjunction ('(&&&)') as 'mappend' @@ -223,14 +242,14 @@ data Cond (sch::Type) (tab::NameNSK) where EmptyCond :: Cond sch tab -- ^ Empty Condition. Neutral for conjunction '(&&&)' and disjunction '(|||)'. - Cmp :: forall fld v sch tab fd. CDBValue sch tab fld fd v => Cmp -> v -> Cond sch tab + Cmp :: forall fld v sch tab. CDBValue sch tab fld v => Cmp -> v -> Cond sch tab -- ^ Comparing field value with parameter - In :: forall fld v sch tab fd. CDBValue sch tab fld fd v => NonEmpty v -> Cond sch tab + In :: forall fld v sch tab. CDBValue sch tab fld v => NonEmpty v -> Cond sch tab -- ^ Check that field value belongs to non-empty list of values - InArr :: forall fld v sch tab fd. CDBValue sch tab fld fd v => [v] -> Cond sch tab + InArr :: forall fld v sch tab. CDBValue sch tab fld v => [v] -> Cond 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 fd. CDBFieldNullable sch tab fld fd => Cond sch tab + Null :: forall fld sch tab. CDBFieldNullable sch tab fld => Cond sch tab -- ^ Check that field value is @NULL@ Not :: Cond sch tab -> Cond sch tab -- ^ Boolean @NOT@ @@ -274,7 +293,7 @@ -- | Check that field value is @NULL@ {-# INLINE pnull #-} -pnull :: forall sch tab fd. forall name -> CDBFieldNullable sch tab name fd => Cond sch tab +pnull :: forall sch tab. forall name -> CDBFieldNullable sch tab name => Cond sch tab pnull name = Null @name -- | True when related rows exist in the child table and satisfy the nested condition there @@ -305,14 +324,14 @@ -- | Check that field value belongs to non-empty list of values {-# INLINE pin #-} -pin :: forall name -> forall sch tab fd v. CDBValue sch tab name fd v +pin :: forall name -> forall sch tab v. CDBValue sch tab name v => NonEmpty v -> Cond 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 fd v. CDBValue sch tab name fd v +pinArr :: forall name -> forall sch tab v. CDBValue sch tab name v => [v] -> Cond sch tab pinArr name = InArr @name @@ -337,14 +356,14 @@ {-# INLINE (~=?) #-} {-# INLINE (~~?) #-} (?),(<=?),(>=?),(=?) - :: forall fld -> forall sch tab fd v. CDBValue sch tab fld fd v => v -> Cond sch tab + :: forall fld -> forall sch tab v. CDBValue sch tab fld v => v -> Cond sch tab 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 fd v. CDBValue sch tab fld fd v => v -> Cond sch tab + :: forall fld -> forall sch tab v. CDBValue sch tab fld v => v -> Cond sch tab x ~=? b = Cmp @x Like b x ~~? b = Cmp @x ILike b infix 4 ?, <=?, >=?, =?, ~=?, ~~? @@ -352,7 +371,7 @@ data OrdDirection = Asc | Desc deriving Show data OrdFld sch tab where - OrdFld :: forall fld sch tab fd. CDBField sch tab fld fd => + OrdFld :: forall fld sch tab. CDBField sch tab fld => OrdDirection -> OrdFld sch tab UnsafeOrd :: CondMonad (Text, OrdDirection) -> OrdFld sch tab @@ -371,16 +390,16 @@ {-# INLINE ordf #-} ordf - :: forall fld -> forall sch tab fd. CDBField sch tab fld fd + :: forall fld -> forall sch tab. CDBField sch tab fld => OrdDirection -> OrdFld sch tab ordf fld = OrdFld @fld {-# INLINE ascf #-} -ascf :: forall fld -> forall sch tab fd. CDBField sch tab fld fd => OrdFld sch tab +ascf :: forall fld -> forall sch tab. CDBField sch tab fld => OrdFld sch tab ascf fld = ordf fld Asc {-# INLINE descf #-} -descf :: forall fld -> forall sch tab fd. CDBField sch tab fld fd => OrdFld sch tab +descf :: forall fld -> forall sch tab. CDBField sch tab fld => OrdFld sch tab descf fld = ordf fld Desc data LO = LO diff --git a/src/PgSchema/Generation.hs b/src/PgSchema/Generation.hs --- a/src/PgSchema/Generation.hs +++ b/src/PgSchema/Generation.hs @@ -258,19 +258,10 @@ handle (const @_ @SomeException $ pure "") (fromString <$> getEnv env) moduleText = genModuleText moduleName schName . getDefs -mkInst :: ShowType a => Text -> [Text] -> a -> Text -mkInst name pars a - = "instance C" <> sgn <> " where\n" - <> " type T" <> sgn <> " = \n" - <> " " <> showSplit 6 70 a <> "\n" - where - sgn = T.intercalate " " (name : pars) - textTypDef :: Text -> NameNS -> TypDef -> Text -textTypDef sch typ td@TypDef {..} = mkInst "TypDef" ss td <> pgEnum +textTypDef sch typ TypDef {..} = pgEnum where - ss = [sch, showType typ] - st = T.intercalate " " ss + st = T.intercalate " " [sch, showType typ] pgEnum | L.null typEnum = "" | otherwise @@ -284,24 +275,6 @@ #endif <> "instance NFData (PGEnum " <> st <> ")\n\n" -textTabDef :: Text -> NameNS -> TabDef -> Text -textTabDef sch tab = mkInst "TabDef" [sch, showType tab] - -textRelDef :: Text -> NameNS -> RelDef -> Text -textRelDef sch relName rel = - "instance CRelDef " <> sch <> " " <> showType relName <> " where\n" <> - " type TRelDef " <> sch <> " " <> showType relName <> " = " <> showType rel <> "\n\n" - -textTabRel :: Text -> NameNS -> [NameNS] -> [NameNS] -> Text -textTabRel sch tab froms tos - = "instance CTabRels " <> pars <> " where\n" - <> " type TFrom " <> pars <> " = \n" - <> " " <> showSplit 6 70 froms <> "\n" - <> " type TTo " <> pars <> " = \n" - <> " " <> showSplit 6 70 tos <> "\n" - where - pars = T.intercalate " " [sch, showType tab] - -- Generate Ref in type-level format (using 'FldDef directly) textRef :: FldDef -> FldDef -> Text -> Text -> Text textRef fromDef toDef fromName toName = @@ -314,32 +287,35 @@ rhsToHere :: NameNS -> NameNS -> RelDef -> M.Map (NameNS, Text) FldDef -> Text rhsToHere tab fromTab rel mfld = - let refsText = T.intercalate "\n , " $ - [ textRef (mfld M.! (fromTab, fromName)) (mfld M.! (tab, toName)) fromName toName - | (fromName, toName) <- rdCols rel - ] - in "'RFToHere " <> showType fromTab <> "\n '[ " <> refsText <> " ]" + "'RFToHere " <> showType fromTab <> "\n '[ " <> refsText <> " ]" + where + refsText = T.intercalate "\n , " $ + [ textRef (mfld M.! (fromTab, fromName)) (mfld M.! (tab, toName)) fromName toName + | (fromName, toName) <- rdCols rel ] rhsFromHere :: NameNS -> NameNS -> RelDef -> M.Map (NameNS, Text) FldDef -> Text rhsFromHere tab toTab rel mfld = - let refsText = T.intercalate "\n , " $ - [ textRef (mfld M.! (tab, fromName)) (mfld M.! (toTab, toName)) fromName toName - | (fromName, toName) <- rdCols rel - ] - in "'RFFromHere " <> showType toTab <> "\n '[ " <> refsText <> " ]" + "'RFFromHere " <> showType toTab <> "\n '[ " <> refsText <> " ]" + where + refsText = T.intercalate "\n , " + [ textRef (mfld M.! (tab, fromName)) (mfld M.! (toTab, toName)) fromName toName + | (fromName, toName) <- rdCols rel ] rhsSelfRef :: NameNS -> RelDef -> M.Map (NameNS, Text) FldDef -> Text rhsSelfRef tab rel mfld = - let refsText = T.intercalate "\n , " $ - [ textRef (mfld M.! (tab, fromName)) (mfld M.! (tab, toName)) fromName toName - | (fromName, toName) <- rdCols rel - ] - in "'RFSelfRef " <> showType tab <> "\n '[ " <> refsText <> " ]" + "'RFSelfRef " <> showType tab <> "\n '[ " <> refsText <> " ]" + where + refsText = T.intercalate "\n , " + [ textRef (mfld M.! (tab, fromName)) (mfld M.! (tab, toName)) fromName toName + | (fromName, toName) <- rdCols rel ] -- Closed type family TDBFieldInfo and single CDBFieldInfo instance -typeFamilyName :: Text -> Text -typeFamilyName sch = "TDBFieldInfo" <> sch +listValsText :: [Text] -> Text +listValsText xs = if L.null xs then "" else T.intercalate ", " xs +nameNSText :: NameNS -> Text +nameNSText NameNS {..} = nnsNamespace <> "." <> nnsName + typeErrorMsg :: Text -> Text -> [Text] -> [Text] -> Text typeErrorMsg sch tabStr fields rels = @@ -367,7 +343,7 @@ <> "instance (ToStar (TDBFieldInfo " <> schName <> " t f), ToStar t, ToStar f) => CDBFieldInfo " <> schName <> " t f where\n" <> " type TDBFieldInfo " <> schName <> " t f = " <> tfName <> " t f\n\n" where - tfName = typeFamilyName schName + tfName = "TDBFieldInfo" <> schName -- All (tab, fldName, rhs) in deterministic order: by table, then plain fields, -- then toHere, then fromHere, then selfRef (for self-FK). plainEntries = @@ -376,21 +352,18 @@ [ (tab, nnsName relName, rhsToHere tab (rdFrom rel) rel mfld) | (tab, (_, _froms, tos)) <- M.toList mtab, relName <- tos , let rel = mrel M.! relName - , not (rdFrom rel == tab && rdTo rel == tab) - ] + , not (rdFrom rel == tab && rdTo rel == tab) ] fromHereEntries = [ (tab, nnsName relName, rhsFromHere tab (rdTo rel) rel mfld) | (tab, (_, froms, _tos)) <- M.toList mtab, relName <- froms , let rel = mrel M.! relName - , not (rdFrom rel == tab && rdTo rel == tab) - ] + , not (rdFrom rel == tab && rdTo rel == tab) ] selfEntries = [ (tab, nnsName relName, rhsSelfRef tab rel mfld) | (tab, (_, froms, tos)) <- M.toList mtab , relName <- L.nub (tos <> froms) , let rel = mrel M.! relName - , rdFrom rel == tab && rdTo rel == tab - ] + , rdFrom rel == tab && rdTo rel == tab ] allEntries = plainEntries <> toHereEntries <> fromHereEntries <> selfEntries eqnLine tab fldName rhs = " " <> tfName <> " " <> showType tab <> " \"" <> fldName <> "\" = " <> rhs <> "\n" @@ -408,7 +381,101 @@ <> "\n TE.:$$: TE.Text \"\"" <> ")" +textClosedTypDefTF :: Text -> M.Map NameNS TypDef -> Text +textClosedTypDefTF schName mtyp = + "type family " <> tfName <> " (name :: NameNSK) :: TypDef' TL.Symbol where\n" + <> mconcat [ " " <> tfName <> " " <> showType t <> " = " <> showType td <> "\n" + | (t, td) <- M.toList mtyp ] + <> " " <> tfName <> " name = " <> typeErrorMsgFinal <> "\n" + <> "instance (ToStar (TTypDef " <> schName <> " name), ToStar name) => CTypDef " + <> schName <> " name where\n" + <> " type TTypDef " <> schName <> " name = " <> tfName <> " name\n\n" + where + tfName = "TTypDef" <> schName + validTypes = listValsText (nameNSText <$> keys mtyp) + typeErrorMsgFinal = + "TE.TypeError (TE.Text \"In schema \" TE.:<>: TE.ShowType " <> schName + <> " TE.:$$: TE.Text \"type \" TE.:<>: TE.ShowType name TE.:<>: TE.Text \" is not defined.\"" + <> "\n TE.:$$: TE.Text \"\"" + <> "\n TE.:$$: TE.Text \"Valid values are:\"" + <> "\n TE.:$$: TE.Text \" Types: " <> validTypes <> ".\"" + <> "\n TE.:$$: TE.Text \"\"" + <> ")" +textClosedTabDefTF :: Text -> M.Map NameNS (TabDef, [NameNS], [NameNS]) -> Text +textClosedTabDefTF schName mtab = + "type family " <> tfName <> " (name :: NameNSK) :: TabDef' TL.Symbol where\n" + <> mconcat [ " " <> tfName <> " " <> showType t <> " = " <> showType td <> "\n" + | (t, (td, _, _)) <- M.toList mtab ] + <> " " <> tfName <> " name = " <> typeErrorMsgFinal <> "\n" + <> "instance (ToStar (TTabDef " <> schName <> " name), ToStar name) => CTabDef " + <> schName <> " name where\n" + <> " type TTabDef " <> schName <> " name = " <> tfName <> " name\n\n" + where + tfName = "TTabDef" <> schName + validTabs = listValsText (nameNSText <$> keys mtab) + typeErrorMsgFinal = + "TE.TypeError (TE.Text \"In schema \" TE.:<>: TE.ShowType " <> schName + <> " TE.:$$: TE.Text \"table \" TE.:<>: TE.ShowType name TE.:<>: TE.Text \" is not defined.\"" + <> "\n TE.:$$: TE.Text \"\"" + <> "\n TE.:$$: TE.Text \"Valid values are:\"" + <> "\n TE.:$$: TE.Text \" Tables: " <> validTabs <> ".\"" + <> "\n TE.:$$: TE.Text \"\"" + <> ")" + +textClosedRelDefTF :: Text -> M.Map NameNS RelDef -> Text +textClosedRelDefTF schName mrel = + "type family " <> tfName <> " (ref :: NameNSK) :: RelDef' TL.Symbol where\n" + <> mconcat [ " " <> tfName <> " " <> showType r <> " = " <> showType rd <> "\n" + | (r, rd) <- M.toList mrel ] + <> " " <> tfName <> " ref = " <> typeErrorMsgFinal <> "\n" + <> "instance ( ToStar (TRelDef " <> schName <> " ref)\n" + <> " , CTabDef " <> schName <> " (RdFrom (TRelDef " <> schName <> " ref))\n" + <> " , CTabDef " <> schName <> " (RdTo (TRelDef " <> schName <> " ref)) )\n" + <> " => CRelDef " <> schName <> " ref where\n" + <> " type TRelDef " <> schName <> " ref = " <> tfName <> " ref\n\n" + where + tfName = "TRelDef" <> schName + validRels = listValsText (nameNSText <$> keys mrel) + typeErrorMsgFinal = + "TE.TypeError (TE.Text \"In schema \" TE.:<>: TE.ShowType " <> schName + <> " TE.:$$: TE.Text \"relation \" TE.:<>: TE.ShowType ref TE.:<>: TE.Text \" is not defined.\"" + <> "\n TE.:$$: TE.Text \"\"" + <> "\n TE.:$$: TE.Text \"Valid values are:\"" + <> "\n TE.:$$: TE.Text \" Relations: " <> validRels <> ".\"" + <> "\n TE.:$$: TE.Text \"\"" + <> ")" + +textClosedTabRelsTF :: Text -> M.Map NameNS (TabDef, [NameNS], [NameNS]) -> Text +textClosedTabRelsTF schName mtab = + "type family " <> tfFrom <> " (tab :: NameNSK) :: [NameNSK] where\n" + <> mconcat [ " " <> tfFrom <> " " <> showType t <> " = " <> showSplit 4 70 froms <> "\n" + | (t, (_, froms, _)) <- M.toList mtab ] + <> " " <> tfFrom <> " tab = " <> fromErr <> "\n\n" + <> "type family " <> tfTo <> " (tab :: NameNSK) :: [NameNSK] where\n" + <> mconcat [ " " <> tfTo <> " " <> showType t <> " = " <> showSplit 4 70 tos <> "\n" + | (t, (_, _, tos)) <- M.toList mtab ] + <> " " <> tfTo <> " tab = " <> toErr <> "\n" + <> "instance CTabRels " <> schName <> " tab where\n" + <> " type TFrom " <> schName <> " tab = " <> tfFrom <> " tab\n" + <> " type TTo " <> schName <> " tab = " <> tfTo <> " tab\n\n" + where + tfFrom = "TFrom" <> schName + tfTo = "TTo" <> schName + validTabs = listValsText (nameNSText <$> keys mtab) + mkErr kind var = + "TE.TypeError (TE.Text \"In schema \" TE.:<>: TE.ShowType " <> schName + <> " TE.:$$: TE.Text \"" <> kind <> " for table \" TE.:<>: TE.ShowType " <> var + <> " TE.:<>: TE.Text \" is not defined.\"" + <> "\n TE.:$$: TE.Text \"\"" + <> "\n TE.:$$: TE.Text \"Valid values are:\"" + <> "\n TE.:$$: TE.Text \" Tables: " <> validTabs <> ".\"" + <> "\n TE.:$$: TE.Text \"\"" + <> ")" + fromErr = mkErr "TFrom" "tab" + toErr = mkErr "TTo" "tab" + + genModuleText :: Text -- ^ module name -> Text -- ^ schema name @@ -437,10 +504,10 @@ <> "import PgSchema.Import\n" <> "data " <> schName <> "\n\n" <> mconcat (uncurry (textTypDef schName) <$> M.toList mtyp) - <> mconcat ((\(tab,(td,_,_)) -> textTabDef schName tab td) <$> M.toList mtab) - <> mconcat ([ textRelDef schName relName rel | (relName, rel) <- M.toList mrel ]) - <> mconcat ((\(tab,(_,froms,tos)) -> textTabRel schName tab froms tos) - <$> M.toList mtab) + <> textClosedTypDefTF schName mtyp + <> textClosedTabDefTF schName mtab + <> textClosedRelDefTF schName mrel + <> textClosedTabRelsTF schName mtab <> textClosedFieldInfoTF schName (mfld, mtab, mrel) <> "instance CSchema " <> schName <> " where\n" <> " type TTabs " <> schName <> " = " <> showSplit 4 70 (keys mtab) <> "\n" diff --git a/src/PgSchema/Import.hs b/src/PgSchema/Import.hs --- a/src/PgSchema/Import.hs +++ b/src/PgSchema/Import.hs @@ -31,7 +31,7 @@ -- * RecField class , RecField'(..), RecFieldK, Ref'(..) -- * TRelDef type family - , CRelDef(..) + , CRelDef(..), RdFrom, RdTo -- * CTabRels class , CTabRels(..) -- * PGEnum type diff --git a/src/PgSchema/Schema.hs b/src/PgSchema/Schema.hs --- a/src/PgSchema/Schema.hs +++ b/src/PgSchema/Schema.hs @@ -122,7 +122,7 @@ RestMandatory' sch t rs (fld ': fs) res = RestMandatory'' sch t rs fs res fld (IsMandatory' sch t fld && Not (Elem' fld rs)) -type family RestMandatory'' (sch :: k) (t :: NameNSK) (rs :: [Symbol]) +type family RestMandatory'' sch (t :: NameNSK) (rs :: [Symbol]) (fs :: [Symbol]) (res :: [Symbol]) (fld :: Symbol) (b :: Bool) :: [Symbol] where RestMandatory'' sch t rs fs res fld 'True = fld ': RestMandatory' sch t rs fs res RestMandatory'' sch t rs fs res fld 'False = RestMandatory' sch t rs fs res @@ -131,8 +131,11 @@ type family RestPK' (rs :: [Symbol]) (fs :: [Symbol]) (res :: [Symbol]) :: [Symbol] where RestPK' rs '[] res = res - RestPK' rs (fld ': fs) res = - RestPK' rs fs (If (Not (Elem' fld rs)) (fld ': res) res) + RestPK' rs (fld ': fs) res = RestPK'' rs fs fld res (Elem' fld rs) + +type family RestPK'' rs fs fld (res :: [Symbol]) (b :: Bool) :: [Symbol] where + RestPK'' rs fs fld res 'True = RestPK' rs fs res + RestPK'' rs fs fld res 'False = RestPK' rs fs (fld ': res) type RestPK sch t rs = RestPK' rs (TdKey (TTabDef sch t)) '[] diff --git a/test-pgs/Sch.hs b/test-pgs/Sch.hs --- a/test-pgs/Sch.hs +++ b/test-pgs/Sch.hs @@ -17,114 +17,6 @@ import PgSchema.Import data Sch -instance CTypDef Sch ( "pg_catalog" ->> "_bool" ) where - type TTypDef Sch ( "pg_catalog" ->> "_bool" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "bool" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_bytea" ) where - type TTypDef Sch ( "pg_catalog" ->> "_bytea" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "bytea" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_date" ) where - type TTypDef Sch ( "pg_catalog" ->> "_date" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "date" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_float8" ) where - type TTypDef Sch ( "pg_catalog" ->> "_float8" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "float8" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_int4" ) where - type TTypDef Sch ( "pg_catalog" ->> "_int4" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "int4" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_jsonb" ) where - type TTypDef Sch ( "pg_catalog" ->> "_jsonb" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "jsonb" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_text" ) where - type TTypDef Sch ( "pg_catalog" ->> "_text" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "text" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_timestamptz" ) where - type TTypDef Sch ( "pg_catalog" ->> "_timestamptz" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "timestamptz" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "_uuid" ) where - type TTypDef Sch ( "pg_catalog" ->> "_uuid" ) = - 'TypDef "A" ('Just ( "pg_catalog" ->> "uuid" )) '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "bool" ) where - type TTypDef Sch ( "pg_catalog" ->> "bool" ) = - 'TypDef "B" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "bytea" ) where - type TTypDef Sch ( "pg_catalog" ->> "bytea" ) = - 'TypDef "U" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "date" ) where - type TTypDef Sch ( "pg_catalog" ->> "date" ) = - 'TypDef "D" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "float4" ) where - type TTypDef Sch ( "pg_catalog" ->> "float4" ) = - 'TypDef "N" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "float8" ) where - type TTypDef Sch ( "pg_catalog" ->> "float8" ) = - 'TypDef "N" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "int4" ) where - type TTypDef Sch ( "pg_catalog" ->> "int4" ) = - 'TypDef "N" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "int8" ) where - type TTypDef Sch ( "pg_catalog" ->> "int8" ) = - 'TypDef "N" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "json" ) where - type TTypDef Sch ( "pg_catalog" ->> "json" ) = - 'TypDef "U" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "jsonb" ) where - type TTypDef Sch ( "pg_catalog" ->> "jsonb" ) = - 'TypDef "U" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "text" ) where - type TTypDef Sch ( "pg_catalog" ->> "text" ) = - 'TypDef "S" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "time" ) where - type TTypDef Sch ( "pg_catalog" ->> "time" ) = - 'TypDef "D" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "timestamp" ) where - type TTypDef Sch ( "pg_catalog" ->> "timestamp" ) = - 'TypDef "D" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "timestamptz" ) where - type TTypDef Sch ( "pg_catalog" ->> "timestamptz" ) = - 'TypDef "D" 'Nothing '[ ] - -instance CTypDef Sch ( "pg_catalog" ->> "uuid" ) where - type TTypDef Sch ( "pg_catalog" ->> "uuid" ) = - 'TypDef "U" 'Nothing '[ ] - -instance CTypDef Sch ( "public" ->> "_citext" ) where - type TTypDef Sch ( "public" ->> "_citext" ) = - 'TypDef "A" ('Just ( "public" ->> "citext" )) '[ ] - -instance CTypDef Sch ( "public" ->> "citext" ) where - type TTypDef Sch ( "public" ->> "citext" ) = - 'TypDef "S" 'Nothing '[ ] - -instance CTypDef Sch ( "test_pgs" ->> "_color" ) where - type TTypDef Sch ( "test_pgs" ->> "_color" ) = - 'TypDef "A" ('Just ( "test_pgs" ->> "color" )) '[ ] - -instance CTypDef Sch ( "test_pgs" ->> "color" ) where - type TTypDef Sch ( "test_pgs" ->> "color" ) = - 'TypDef "E" 'Nothing '[ "red","green","blue" ] - data instance PGEnum Sch ( "test_pgs" ->> "color" ) = Color_red | Color_green | Color_blue deriving (Show, Read, Ord, Eq, Generic, Bounded, Enum) @@ -133,143 +25,138 @@ instance NFData (PGEnum Sch ( "test_pgs" ->> "color" )) -instance CTabDef Sch ( "test_pgs" ->> "arrays" ) where - type TTabDef Sch ( "test_pgs" ->> "arrays" ) = - 'TabDef '[ "id","root_id","dates_nullable","jsons" ] '[ "id" ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "base_arr_converts" ) where - type TTabDef Sch ( "test_pgs" ->> "base_arr_converts" ) = - 'TabDef '[ "cboolean" - ,"cint4","cfloat8","ctimestamptz","ctext" ] '[ ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "base_converts" ) where - type TTabDef Sch ( "test_pgs" ->> "base_converts" ) = - 'TabDef '[ "cboolean","cint4" - ,"cfloat8","cdate","ctime","ctimestamp","ctimestamptz","ctext" ] '[ ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "dim" ) where - type TTabDef Sch ( "test_pgs" ->> "dim" ) = - 'TabDef '[ "id","name" ] '[ "id" ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "ext_arr_converts" ) where - type TTabDef Sch ( "test_pgs" ->> "ext_arr_converts" ) = - 'TabDef '[ "ccitext","cbytea","cjsonb","cuuid","ccolor" ] '[ ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "ext_converts" ) where - type TTabDef Sch ( "test_pgs" ->> "ext_converts" ) = - 'TabDef '[ "ccitext" - ,"cbytea","cjsonb","cjson","cuuid","ccolor" ] '[ ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "leaf" ) where - type TTabDef Sch ( "test_pgs" ->> "leaf" ) = - 'TabDef '[ "root_id","seq","leaf_no" - ,"value","category","created_at" ] '[ "root_id","seq","leaf_no" ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "mid1" ) where - type TTabDef Sch ( "test_pgs" ->> "mid1" ) = - 'TabDef '[ "id" - ,"root_id","pos","flag","sort_key","payload" ] '[ "id" ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "mid2" ) where - type TTabDef Sch ( "test_pgs" ->> "mid2" ) = - 'TabDef '[ "root_id" - ,"seq","kind","flag","priority","payload" ] '[ "root_id","seq" ] '[ ] - -instance CTabDef Sch ( "test_pgs" ->> "root" ) where - type TTabDef Sch ( "test_pgs" ->> "root" ) = - 'TabDef '[ "id","code","grp","name" - ,"created_at","dim_a_id","dim_b_id" ] '[ "id" ] '[ '[ "code","grp" ] ] - -instance CRelDef Sch ( "test_pgs" ->> "arrays_root_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "arrays_root_fk" ) = 'RelDef ( "test_pgs" ->> "arrays" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] - -instance CRelDef Sch ( "test_pgs" ->> "leaf_mid2_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "leaf_mid2_fk" ) = 'RelDef ( "test_pgs" ->> "leaf" ) ( "test_pgs" ->> "mid2" ) '[ '( "root_id","root_id" ),'( "seq","seq" ) ] +type family TTypDefSch (name :: NameNSK) :: TypDef' TL.Symbol where + TTypDefSch ( "pg_catalog" ->> "_bool" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "bool" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_bytea" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "bytea" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_date" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "date" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_float8" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "float8" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_int4" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "int4" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_jsonb" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "jsonb" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_text" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "text" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_timestamptz" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "timestamptz" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "_uuid" ) = 'TypDef "A" ('Just ( "pg_catalog" ->> "uuid" )) '[ ] + TTypDefSch ( "pg_catalog" ->> "bool" ) = 'TypDef "B" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "bytea" ) = 'TypDef "U" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "date" ) = 'TypDef "D" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "float4" ) = 'TypDef "N" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "float8" ) = 'TypDef "N" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "int4" ) = 'TypDef "N" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "int8" ) = 'TypDef "N" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "json" ) = 'TypDef "U" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "jsonb" ) = 'TypDef "U" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "text" ) = 'TypDef "S" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "time" ) = 'TypDef "D" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "timestamp" ) = 'TypDef "D" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "timestamptz" ) = 'TypDef "D" 'Nothing '[ ] + TTypDefSch ( "pg_catalog" ->> "uuid" ) = 'TypDef "U" 'Nothing '[ ] + TTypDefSch ( "public" ->> "_citext" ) = 'TypDef "A" ('Just ( "public" ->> "citext" )) '[ ] + TTypDefSch ( "public" ->> "citext" ) = 'TypDef "S" 'Nothing '[ ] + TTypDefSch ( "test_pgs" ->> "_color" ) = 'TypDef "A" ('Just ( "test_pgs" ->> "color" )) '[ ] + TTypDefSch ( "test_pgs" ->> "color" ) = 'TypDef "E" 'Nothing '[ "red","green","blue" ] + TTypDefSch name = TE.TypeError (TE.Text "In schema " TE.:<>: TE.ShowType Sch TE.:$$: TE.Text "type " TE.:<>: TE.ShowType name TE.:<>: TE.Text " is not defined." + TE.:$$: TE.Text "" + TE.:$$: TE.Text "Valid values are:" + TE.:$$: TE.Text " Types: pg_catalog._bool, pg_catalog._bytea, pg_catalog._date, pg_catalog._float8, pg_catalog._int4, pg_catalog._jsonb, pg_catalog._text, pg_catalog._timestamptz, pg_catalog._uuid, pg_catalog.bool, pg_catalog.bytea, pg_catalog.date, pg_catalog.float4, pg_catalog.float8, pg_catalog.int4, pg_catalog.int8, pg_catalog.json, pg_catalog.jsonb, pg_catalog.text, pg_catalog.time, pg_catalog.timestamp, pg_catalog.timestamptz, pg_catalog.uuid, public._citext, public.citext, test_pgs._color, test_pgs.color." + TE.:$$: TE.Text "") +instance (ToStar (TTypDef Sch name), ToStar name) => CTypDef Sch name where + type TTypDef Sch name = TTypDefSch name -instance CRelDef Sch ( "test_pgs" ->> "mid1_root_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "mid1_root_fk" ) = 'RelDef ( "test_pgs" ->> "mid1" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] +type family TTabDefSch (name :: NameNSK) :: TabDef' TL.Symbol where + TTabDefSch ( "test_pgs" ->> "arrays" ) = 'TabDef '[ "id","root_id","dates_nullable","jsons" ] '[ "id" ] '[ ] + TTabDefSch ( "test_pgs" ->> "base_arr_converts" ) = 'TabDef '[ "cboolean","cint4","cfloat8","ctimestamptz","ctext" ] '[ ] '[ ] + TTabDefSch ( "test_pgs" ->> "base_converts" ) = 'TabDef '[ "cboolean","cint4","cfloat8","cdate","ctime","ctimestamp","ctimestamptz","ctext" ] '[ ] '[ ] + TTabDefSch ( "test_pgs" ->> "dim" ) = 'TabDef '[ "id","name" ] '[ "id" ] '[ ] + TTabDefSch ( "test_pgs" ->> "ext_arr_converts" ) = 'TabDef '[ "ccitext","cbytea","cjsonb","cuuid","ccolor" ] '[ ] '[ ] + TTabDefSch ( "test_pgs" ->> "ext_converts" ) = 'TabDef '[ "ccitext","cbytea","cjsonb","cjson","cuuid","ccolor" ] '[ ] '[ ] + TTabDefSch ( "test_pgs" ->> "leaf" ) = 'TabDef '[ "root_id","seq","leaf_no","value","category","created_at" ] '[ "root_id","seq","leaf_no" ] '[ ] + TTabDefSch ( "test_pgs" ->> "mid1" ) = 'TabDef '[ "id","root_id","pos","flag","sort_key","payload" ] '[ "id" ] '[ ] + TTabDefSch ( "test_pgs" ->> "mid2" ) = 'TabDef '[ "root_id","seq","kind","flag","priority","payload" ] '[ "root_id","seq" ] '[ ] + TTabDefSch ( "test_pgs" ->> "root" ) = 'TabDef '[ "id","code","grp","name","created_at","dim_a_id","dim_b_id" ] '[ "id" ] '[ '[ "code","grp" ] ] + TTabDefSch name = TE.TypeError (TE.Text "In schema " TE.:<>: TE.ShowType Sch TE.:$$: TE.Text "table " TE.:<>: TE.ShowType name TE.:<>: TE.Text " is not defined." + TE.:$$: TE.Text "" + TE.:$$: TE.Text "Valid values are:" + TE.:$$: TE.Text " Tables: test_pgs.arrays, test_pgs.base_arr_converts, test_pgs.base_converts, test_pgs.dim, test_pgs.ext_arr_converts, test_pgs.ext_converts, test_pgs.leaf, test_pgs.mid1, test_pgs.mid2, test_pgs.root." + TE.:$$: TE.Text "") +instance (ToStar (TTabDef Sch name), ToStar name) => CTabDef Sch name where + type TTabDef Sch name = TTabDefSch name -instance CRelDef Sch ( "test_pgs" ->> "mid2_root_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "mid2_root_fk" ) = 'RelDef ( "test_pgs" ->> "mid2" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] +type family TRelDefSch (ref :: NameNSK) :: RelDef' TL.Symbol where + TRelDefSch ( "test_pgs" ->> "arrays_root_fk" ) = 'RelDef ( "test_pgs" ->> "arrays" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] + TRelDefSch ( "test_pgs" ->> "leaf_mid2_fk" ) = 'RelDef ( "test_pgs" ->> "leaf" ) ( "test_pgs" ->> "mid2" ) '[ '( "root_id","root_id" ),'( "seq","seq" ) ] + TRelDefSch ( "test_pgs" ->> "mid1_root_fk" ) = 'RelDef ( "test_pgs" ->> "mid1" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] + TRelDefSch ( "test_pgs" ->> "mid2_root_fk" ) = 'RelDef ( "test_pgs" ->> "mid2" ) ( "test_pgs" ->> "root" ) '[ '( "root_id","id" ) ] + TRelDefSch ( "test_pgs" ->> "root_dim_a_fk" ) = 'RelDef ( "test_pgs" ->> "root" ) ( "test_pgs" ->> "dim" ) '[ '( "dim_a_id","id" ) ] + TRelDefSch ( "test_pgs" ->> "root_dim_b_fk" ) = 'RelDef ( "test_pgs" ->> "root" ) ( "test_pgs" ->> "dim" ) '[ '( "dim_b_id","id" ) ] + TRelDefSch ref = TE.TypeError (TE.Text "In schema " TE.:<>: TE.ShowType Sch TE.:$$: TE.Text "relation " TE.:<>: TE.ShowType ref TE.:<>: TE.Text " is not defined." + TE.:$$: TE.Text "" + TE.:$$: TE.Text "Valid values are:" + TE.:$$: TE.Text " Relations: test_pgs.arrays_root_fk, test_pgs.leaf_mid2_fk, test_pgs.mid1_root_fk, test_pgs.mid2_root_fk, test_pgs.root_dim_a_fk, test_pgs.root_dim_b_fk." + TE.:$$: TE.Text "") +instance ( ToStar (TRelDef Sch ref) + , CTabDef Sch (RdFrom (TRelDef Sch ref)) + , CTabDef Sch (RdTo (TRelDef Sch ref)) ) + => CRelDef Sch ref where + type TRelDef Sch ref = TRelDefSch ref -instance CRelDef Sch ( "test_pgs" ->> "root_dim_a_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "root_dim_a_fk" ) = 'RelDef ( "test_pgs" ->> "root" ) ( "test_pgs" ->> "dim" ) '[ '( "dim_a_id","id" ) ] +type family TFromSch (tab :: NameNSK) :: [NameNSK] where + TFromSch ( "test_pgs" ->> "arrays" ) = '[ ( "test_pgs" ->> "arrays_root_fk" ) ] -instance CRelDef Sch ( "test_pgs" ->> "root_dim_b_fk" ) where - type TRelDef Sch ( "test_pgs" ->> "root_dim_b_fk" ) = 'RelDef ( "test_pgs" ->> "root" ) ( "test_pgs" ->> "dim" ) '[ '( "dim_b_id","id" ) ] + TFromSch ( "test_pgs" ->> "base_arr_converts" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "arrays" ) where - type TFrom Sch ( "test_pgs" ->> "arrays" ) = - '[ ( "test_pgs" ->> "arrays_root_fk" ) ] + TFromSch ( "test_pgs" ->> "base_converts" ) = '[ ] - type TTo Sch ( "test_pgs" ->> "arrays" ) = - '[ ] + TFromSch ( "test_pgs" ->> "dim" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "base_arr_converts" ) where - type TFrom Sch ( "test_pgs" ->> "base_arr_converts" ) = - '[ ] + TFromSch ( "test_pgs" ->> "ext_arr_converts" ) = '[ ] - type TTo Sch ( "test_pgs" ->> "base_arr_converts" ) = - '[ ] + TFromSch ( "test_pgs" ->> "ext_converts" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "base_converts" ) where - type TFrom Sch ( "test_pgs" ->> "base_converts" ) = - '[ ] + TFromSch ( "test_pgs" ->> "leaf" ) = '[ ( "test_pgs" ->> "leaf_mid2_fk" ) ] - type TTo Sch ( "test_pgs" ->> "base_converts" ) = - '[ ] + TFromSch ( "test_pgs" ->> "mid1" ) = '[ ( "test_pgs" ->> "mid1_root_fk" ) ] -instance CTabRels Sch ( "test_pgs" ->> "dim" ) where - type TFrom Sch ( "test_pgs" ->> "dim" ) = - '[ ] + TFromSch ( "test_pgs" ->> "mid2" ) = '[ ( "test_pgs" ->> "mid2_root_fk" ) ] - type TTo Sch ( "test_pgs" ->> "dim" ) = - '[ ( "test_pgs" ->> "root_dim_a_fk" ) - ,( "test_pgs" ->> "root_dim_b_fk" ) ] + TFromSch ( "test_pgs" ->> "root" ) = '[ ( "test_pgs" ->> "root_dim_a_fk" ) + ,( "test_pgs" ->> "root_dim_b_fk" ) ] -instance CTabRels Sch ( "test_pgs" ->> "ext_arr_converts" ) where - type TFrom Sch ( "test_pgs" ->> "ext_arr_converts" ) = - '[ ] + TFromSch tab = TE.TypeError (TE.Text "In schema " TE.:<>: TE.ShowType Sch TE.:$$: TE.Text "TFrom for table " TE.:<>: TE.ShowType tab TE.:<>: TE.Text " is not defined." + TE.:$$: TE.Text "" + TE.:$$: TE.Text "Valid values are:" + TE.:$$: TE.Text " Tables: test_pgs.arrays, test_pgs.base_arr_converts, test_pgs.base_converts, test_pgs.dim, test_pgs.ext_arr_converts, test_pgs.ext_converts, test_pgs.leaf, test_pgs.mid1, test_pgs.mid2, test_pgs.root." + TE.:$$: TE.Text "") - type TTo Sch ( "test_pgs" ->> "ext_arr_converts" ) = - '[ ] +type family TToSch (tab :: NameNSK) :: [NameNSK] where + TToSch ( "test_pgs" ->> "arrays" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "ext_converts" ) where - type TFrom Sch ( "test_pgs" ->> "ext_converts" ) = - '[ ] + TToSch ( "test_pgs" ->> "base_arr_converts" ) = '[ ] - type TTo Sch ( "test_pgs" ->> "ext_converts" ) = - '[ ] + TToSch ( "test_pgs" ->> "base_converts" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "leaf" ) where - type TFrom Sch ( "test_pgs" ->> "leaf" ) = - '[ ( "test_pgs" ->> "leaf_mid2_fk" ) ] + TToSch ( "test_pgs" ->> "dim" ) = '[ ( "test_pgs" ->> "root_dim_a_fk" ) + ,( "test_pgs" ->> "root_dim_b_fk" ) ] - type TTo Sch ( "test_pgs" ->> "leaf" ) = - '[ ] + TToSch ( "test_pgs" ->> "ext_arr_converts" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "mid1" ) where - type TFrom Sch ( "test_pgs" ->> "mid1" ) = - '[ ( "test_pgs" ->> "mid1_root_fk" ) ] + TToSch ( "test_pgs" ->> "ext_converts" ) = '[ ] - type TTo Sch ( "test_pgs" ->> "mid1" ) = - '[ ] + TToSch ( "test_pgs" ->> "leaf" ) = '[ ] -instance CTabRels Sch ( "test_pgs" ->> "mid2" ) where - type TFrom Sch ( "test_pgs" ->> "mid2" ) = - '[ ( "test_pgs" ->> "mid2_root_fk" ) ] + TToSch ( "test_pgs" ->> "mid1" ) = '[ ] - type TTo Sch ( "test_pgs" ->> "mid2" ) = - '[ ( "test_pgs" ->> "leaf_mid2_fk" ) ] + TToSch ( "test_pgs" ->> "mid2" ) = '[ ( "test_pgs" ->> "leaf_mid2_fk" ) ] -instance CTabRels Sch ( "test_pgs" ->> "root" ) where - type TFrom Sch ( "test_pgs" ->> "root" ) = - '[ ( "test_pgs" ->> "root_dim_a_fk" ) - ,( "test_pgs" ->> "root_dim_b_fk" ) ] + TToSch ( "test_pgs" ->> "root" ) = '[ ( "test_pgs" ->> "arrays_root_fk" ) + ,( "test_pgs" ->> "mid1_root_fk" ),( "test_pgs" ->> "mid2_root_fk" ) ] - type TTo Sch ( "test_pgs" ->> "root" ) = - '[ ( "test_pgs" ->> "arrays_root_fk" ) - ,( "test_pgs" ->> "mid1_root_fk" ),( "test_pgs" ->> "mid2_root_fk" ) ] + TToSch tab = TE.TypeError (TE.Text "In schema " TE.:<>: TE.ShowType Sch TE.:$$: TE.Text "TTo for table " TE.:<>: TE.ShowType tab TE.:<>: TE.Text " is not defined." + TE.:$$: TE.Text "" + TE.:$$: TE.Text "Valid values are:" + TE.:$$: TE.Text " Tables: test_pgs.arrays, test_pgs.base_arr_converts, test_pgs.base_converts, test_pgs.dim, test_pgs.ext_arr_converts, test_pgs.ext_converts, test_pgs.leaf, test_pgs.mid1, test_pgs.mid2, test_pgs.root." + TE.:$$: TE.Text "") +instance CTabRels Sch tab where + type TFrom Sch tab = TFromSch tab + type TTo Sch tab = TToSch tab type family TDBFieldInfoSch (t :: NameNSK) (f :: TL.Symbol) :: RecFieldK NameNSK where TDBFieldInfoSch ( "test_pgs" ->> "arrays" ) "dates_nullable" = 'RFPlain ('FldDef ( "pg_catalog" ->> "_date" ) 'True 'False)