{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ParallelListComp #-}
module PgSchema.Schema where

import Data.Kind
import Data.List as L
import Data.Map as M
import Data.Singletons
import Data.Singletons.TH
import Data.String
import Data.Text as T hiding (show)
import Data.Type.Bool
import Data.Type.Equality
import GHC.TypeLits
import PgSchema.Utils.Instances()
import PgSchema.Utils.Internal
import PgSchema.Utils.TF


-- | Supported SQL aggregate functions
data AggrFun = ACount | AMin | AMax | ASum | AAvg
  deriving Int -> AggrFun -> ShowS
[AggrFun] -> ShowS
AggrFun -> String
(Int -> AggrFun -> ShowS)
-> (AggrFun -> String) -> ([AggrFun] -> ShowS) -> Show AggrFun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AggrFun -> ShowS
showsPrec :: Int -> AggrFun -> ShowS
$cshow :: AggrFun -> String
show :: AggrFun -> String
$cshowList :: [AggrFun] -> ShowS
showList :: [AggrFun] -> ShowS
Show

-- | Qualified PostgreSQL name: namespace (schema) + local name.
data NameNS' s = NameNS
  { forall s. NameNS' s -> s
nnsNamespace :: s -- ^ Namespace (database schema), e.g. @public@ or @pg_catalog@.
  , forall s. NameNS' s -> s
nnsName :: s      -- ^ Unqualified table / relation / type name.
  } deriving (Int -> NameNS' s -> ShowS
[NameNS' s] -> ShowS
NameNS' s -> String
(Int -> NameNS' s -> ShowS)
-> (NameNS' s -> String)
-> ([NameNS' s] -> ShowS)
-> Show (NameNS' s)
forall s. Show s => Int -> NameNS' s -> ShowS
forall s. Show s => [NameNS' s] -> ShowS
forall s. Show s => NameNS' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> NameNS' s -> ShowS
showsPrec :: Int -> NameNS' s -> ShowS
$cshow :: forall s. Show s => NameNS' s -> String
show :: NameNS' s -> String
$cshowList :: forall s. Show s => [NameNS' s] -> ShowS
showList :: [NameNS' s] -> ShowS
Show, NameNS' s -> NameNS' s -> Bool
(NameNS' s -> NameNS' s -> Bool)
-> (NameNS' s -> NameNS' s -> Bool) -> Eq (NameNS' s)
forall s. Eq s => NameNS' s -> NameNS' s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall s. Eq s => NameNS' s -> NameNS' s -> Bool
== :: NameNS' s -> NameNS' s -> Bool
$c/= :: forall s. Eq s => NameNS' s -> NameNS' s -> Bool
/= :: NameNS' s -> NameNS' s -> Bool
Eq, Eq (NameNS' s)
Eq (NameNS' s) =>
(NameNS' s -> NameNS' s -> Ordering)
-> (NameNS' s -> NameNS' s -> Bool)
-> (NameNS' s -> NameNS' s -> Bool)
-> (NameNS' s -> NameNS' s -> Bool)
-> (NameNS' s -> NameNS' s -> Bool)
-> (NameNS' s -> NameNS' s -> NameNS' s)
-> (NameNS' s -> NameNS' s -> NameNS' s)
-> Ord (NameNS' s)
NameNS' s -> NameNS' s -> Bool
NameNS' s -> NameNS' s -> Ordering
NameNS' s -> NameNS' s -> NameNS' s
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. Ord s => Eq (NameNS' s)
forall s. Ord s => NameNS' s -> NameNS' s -> Bool
forall s. Ord s => NameNS' s -> NameNS' s -> Ordering
forall s. Ord s => NameNS' s -> NameNS' s -> NameNS' s
$ccompare :: forall s. Ord s => NameNS' s -> NameNS' s -> Ordering
compare :: NameNS' s -> NameNS' s -> Ordering
$c< :: forall s. Ord s => NameNS' s -> NameNS' s -> Bool
< :: NameNS' s -> NameNS' s -> Bool
$c<= :: forall s. Ord s => NameNS' s -> NameNS' s -> Bool
<= :: NameNS' s -> NameNS' s -> Bool
$c> :: forall s. Ord s => NameNS' s -> NameNS' s -> Bool
> :: NameNS' s -> NameNS' s -> Bool
$c>= :: forall s. Ord s => NameNS' s -> NameNS' s -> Bool
>= :: NameNS' s -> NameNS' s -> Bool
$cmax :: forall s. Ord s => NameNS' s -> NameNS' s -> NameNS' s
max :: NameNS' s -> NameNS' s -> NameNS' s
$cmin :: forall s. Ord s => NameNS' s -> NameNS' s -> NameNS' s
min :: NameNS' s -> NameNS' s -> NameNS' s
Ord)

-- | Description of a PostgreSQL type (category, array element, enum labels).
data TypDef' s = TypDef
  { forall s. TypDef' s -> s
typCategory :: s  -- ^ PostgreSql internal type category
  , forall s. TypDef' s -> Maybe (NameNS' s)
typElem :: Maybe (NameNS' s) -- ^ For array types: element type name; 'Nothing' for non-arrays.
  , forall s. TypDef' s -> [s]
typEnum :: [s] -- ^ Enum label names for enum types; empty list for non-enums.
  } deriving Int -> TypDef' s -> ShowS
[TypDef' s] -> ShowS
TypDef' s -> String
(Int -> TypDef' s -> ShowS)
-> (TypDef' s -> String)
-> ([TypDef' s] -> ShowS)
-> Show (TypDef' s)
forall s. Show s => Int -> TypDef' s -> ShowS
forall s. Show s => [TypDef' s] -> ShowS
forall s. Show s => TypDef' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> TypDef' s -> ShowS
showsPrec :: Int -> TypDef' s -> ShowS
$cshow :: forall s. Show s => TypDef' s -> String
show :: TypDef' s -> String
$cshowList :: forall s. Show s => [TypDef' s] -> ShowS
showList :: [TypDef' s] -> ShowS
Show

-- | Column-level type and nullability/default flags.
data FldDef' s = FldDef
  { forall s. FldDef' s -> NameNS' s
fdType :: NameNS' s   -- ^ PostgreSQL type of the column.
  , forall s. FldDef' s -> Bool
fdNullable :: Bool    -- ^ 'True' if the column allows NULL.
  , forall s. FldDef' s -> Bool
fdHasDefault :: Bool -- ^ 'True' if the column has a default value; affects mandatory-field logic.
  } deriving Int -> FldDef' s -> ShowS
[FldDef' s] -> ShowS
FldDef' s -> String
(Int -> FldDef' s -> ShowS)
-> (FldDef' s -> String)
-> ([FldDef' s] -> ShowS)
-> Show (FldDef' s)
forall s. Show s => Int -> FldDef' s -> ShowS
forall s. Show s => [FldDef' s] -> ShowS
forall s. Show s => FldDef' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> FldDef' s -> ShowS
showsPrec :: Int -> FldDef' s -> ShowS
$cshow :: forall s. Show s => FldDef' s -> String
show :: FldDef' s -> String
$cshowList :: forall s. Show s => [FldDef' s] -> ShowS
showList :: [FldDef' s] -> ShowS
Show

-- | Table shape: ordered column names, primary key, unique constraints.
data TabDef' s = TabDef
  { forall s. TabDef' s -> [s]
tdFlds :: [s]     -- ^ Physical column names in order.
  , forall s. TabDef' s -> [s]
tdKey :: [s]      -- ^ Primary key column names.
  , forall s. TabDef' s -> [[s]]
tdUniq :: [[s]]   -- ^ Unique constraints as lists of column names.
  } deriving Int -> TabDef' s -> ShowS
[TabDef' s] -> ShowS
TabDef' s -> String
(Int -> TabDef' s -> ShowS)
-> (TabDef' s -> String)
-> ([TabDef' s] -> ShowS)
-> Show (TabDef' s)
forall s. Show s => Int -> TabDef' s -> ShowS
forall s. Show s => [TabDef' s] -> ShowS
forall s. Show s => TabDef' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> TabDef' s -> ShowS
showsPrec :: Int -> TabDef' s -> ShowS
$cshow :: forall s. Show s => TabDef' s -> String
show :: TabDef' s -> String
$cshowList :: forall s. Show s => [TabDef' s] -> ShowS
showList :: [TabDef' s] -> ShowS
Show

-- | Foreign-key-style link between two qualified tables and column mapping.
data RelDef' s = RelDef
  { forall s. RelDef' s -> NameNS' s
rdFrom :: NameNS' s -- ^ Referencing table (child).
  , forall s. RelDef' s -> NameNS' s
rdTo :: NameNS' s   -- ^ Referenced table (parent).
  , forall s. RelDef' s -> [(s, s)]
rdCols :: [(s, s)]  -- ^ Pairs @(fromColumn, toColumn)@.
  } deriving Int -> RelDef' s -> ShowS
[RelDef' s] -> ShowS
RelDef' s -> String
(Int -> RelDef' s -> ShowS)
-> (RelDef' s -> String)
-> ([RelDef' s] -> ShowS)
-> Show (RelDef' s)
forall s. Show s => Int -> RelDef' s -> ShowS
forall s. Show s => [RelDef' s] -> ShowS
forall s. Show s => RelDef' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> RelDef' s -> ShowS
showsPrec :: Int -> RelDef' s -> ShowS
$cshow :: forall s. Show s => RelDef' s -> String
show :: RelDef' s -> String
$cshowList :: forall s. Show s => [RelDef' s] -> ShowS
showList :: [RelDef' s] -> ShowS
Show

-- | Cardinality of a relation edge (one vs many from this table’s perspective).
data RelType = RelOne | RelMany deriving Int -> RelType -> ShowS
[RelType] -> ShowS
RelType -> String
(Int -> RelType -> ShowS)
-> (RelType -> String) -> ([RelType] -> ShowS) -> Show RelType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelType -> ShowS
showsPrec :: Int -> RelType -> ShowS
$cshow :: RelType -> String
show :: RelType -> String
$cshowList :: [RelType] -> ShowS
showList :: [RelType] -> ShowS
Show

-- | Field of a logical record: plain column, aggregate, or relation hop.
data RecField' s p
  = RFEmpty s -- ^ Placeholder / unnamed slot (depending on schema codegen).
  | RFPlain (FldDef' s) -- ^ Ordinary column with 'FldDef''.
  | 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@).
  | RFToHere p [Ref' s]
    -- ^ Relation: navigate @p@ toward the current table (“to here”).
  | RFFromHere p [Ref' s]
    -- ^ Relation: navigate @p@ away from the current table (“from here”).
  | RFSelfRef p [Ref' s] -- ^ Self-referential relation through path @p@.
  deriving Int -> RecField' s p -> ShowS
[RecField' s p] -> ShowS
RecField' s p -> String
(Int -> RecField' s p -> ShowS)
-> (RecField' s p -> String)
-> ([RecField' s p] -> ShowS)
-> Show (RecField' s p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s p. (Show s, Show p) => Int -> RecField' s p -> ShowS
forall s p. (Show s, Show p) => [RecField' s p] -> ShowS
forall s p. (Show s, Show p) => RecField' s p -> String
$cshowsPrec :: forall s p. (Show s, Show p) => Int -> RecField' s p -> ShowS
showsPrec :: Int -> RecField' s p -> ShowS
$cshow :: forall s p. (Show s, Show p) => RecField' s p -> String
show :: RecField' s p -> String
$cshowList :: forall s p. (Show s, Show p) => [RecField' s p] -> ShowS
showList :: [RecField' s p] -> ShowS
Show

-- | One step of a join path: source column, types, target column.
data Ref' s = Ref
  { forall s. Ref' s -> s
fromName :: s         -- ^ Source (child) column name.
  , forall s. Ref' s -> FldDef' s
fromDef :: FldDef' s  -- ^ Type/nullability of @fromName@.
  , forall s. Ref' s -> s
toName :: s           -- ^ Target (parent) column name.
  , forall s. Ref' s -> FldDef' s
toDef :: FldDef' s    -- ^ Type/nullability of @toName@.
  } deriving Int -> Ref' s -> ShowS
[Ref' s] -> ShowS
Ref' s -> String
(Int -> Ref' s -> ShowS)
-> (Ref' s -> String) -> ([Ref' s] -> ShowS) -> Show (Ref' s)
forall s. Show s => Int -> Ref' s -> ShowS
forall s. Show s => [Ref' s] -> ShowS
forall s. Show s => Ref' s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall s. Show s => Int -> Ref' s -> ShowS
showsPrec :: Int -> Ref' s -> ShowS
$cshow :: forall s. Show s => Ref' s -> String
show :: Ref' s -> String
$cshowList :: forall s. Show s => [Ref' s] -> ShowS
showList :: [Ref' s] -> ShowS
Show

genSingletons
  [ ''AggrFun, ''NameNS', ''TypDef', ''FldDef', ''TabDef', ''RelDef', ''RelType
  , ''RecField', ''Ref' ]

type NameNSK = NameNS' Symbol
type TypDefK = TypDef' Symbol
type FldDefK = FldDef' Symbol
type TabDefK = TabDef' Symbol
type RelDefK = RelDef' Symbol
type RecFieldK = RecField' Symbol
type RefK = Ref' Symbol

type NameNS = NameNS' Text
type TypDef = TypDef' Text
type FldDef = FldDef' Text
type TabDef = TabDef' Text
type RelDef = RelDef' Text

infixr 9 ->>
(->>) :: Text -> Text -> NameNS
->> :: Text -> Text -> NameNS
(->>) = Text -> Text -> NameNS
forall s. s -> s -> NameNS' s
NameNS

type ns ->> name = 'NameNS ns name

type SimpleType c = 'TypDef c 'Nothing '[]

type family GetRelTab (froms :: [(NameNSK, RelDefK)])
  (tos :: [(NameNSK, RelDefK)]) (s :: Symbol) :: (NameNSK, RelType) where
    GetRelTab '[] '[] s = TypeError ('Text "No relation by name" ':$$: 'ShowType s)
    GetRelTab ('(a,b) ':xs) ys s =
      If (NnsName a == s) '(RdTo b, RelOne) (GetRelTab xs ys s)
    GetRelTab '[] ('(c,d) ':ys) s =
      If (NnsName c == s) '(RdFrom d, RelMany) (GetRelTab '[] ys s)

type family Elem' (x :: Symbol) (xs :: [Symbol]) :: Bool where
  Elem' x '[] = False
  Elem' x (x ': xs) = True
  Elem' x (y ': xs) = Elem' x xs

type IsMandatory fd = Not (FdNullable fd || FdHasDefault fd)
type IsMandatory' sch tab fld = IsMandatory (GetFldDef sch tab fld)

type family RestMandatory' sch t (rs :: [Symbol]) (fs :: [Symbol]) (res :: [Symbol]) :: [Symbol] where
  RestMandatory' sch t rs '[] res = res
  RestMandatory' sch t rs (fld ': fs) res = RestMandatory' sch t rs fs
    (If (IsMandatory' sch t fld && Not (Elem' fld rs)) (fld ': res) res)

type RestMandatory sch t rs = RestMandatory' sch t rs (TdFlds (TTabDef sch t)) '[]

type family RestPK' sch t (rs :: [Symbol]) (fs :: [Symbol]) (res :: [Symbol]) :: [Symbol] where
  RestPK' sch t rs '[] res = res
  RestPK' sch t rs (fld ': fs) res =
    RestPK' sch t rs fs (If (Not (Elem' fld rs)) (fld ': res) res)

type RestPK sch t rs = RestPK' sch t rs (TdKey (TTabDef sch t)) '[]

simpleType :: Text -> TypDef
simpleType :: Text -> TypDef
simpleType Text
c = Text -> Maybe NameNS -> [Text] -> TypDef
forall s. s -> Maybe (NameNS' s) -> [s] -> TypDef' s
TypDef Text
c Maybe NameNS
forall a. Maybe a
Nothing []

type SymNat = (Symbol, Nat)

type KnownSymNat sn = (SingI (NameSymNat sn))

nameSymNat :: forall sn -> KnownSymNat sn => Text
nameSymNat :: forall (sn :: SymNat) -> KnownSymNat sn => Text
nameSymNat sn = forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: Symbol). (SingKind Symbol, SingI a) => Demote Symbol
demote @(NameSymNat sn)
-- >>> nameSymNat ("test", 42)
-- "test___42"

type family NameSymNat (sn :: SymNat) where
  NameSymNat '(s,0) = s
  NameSymNat '(s,n) = AppendSymbol s (AppendSymbol "___" (NatToSymbol n))

-- CTypDef
-- | instances will be generated by code generation
class
  (ToStar name, ToStar (TTypDef sch name)) => CTypDef sch (name :: NameNSK) where

  type TTypDef sch name :: TypDefK

-- | Schema-level field kind for (sch, tab, field name).
-- Instances are generated by codegen (Gen) or defined manually (e.g. Catalog).
class (ToStar (TDBFieldInfo sch tab name), ToStar tab, ToStar name)
  => CDBFieldInfo sch (tab :: NameNSK) (name :: Symbol) where
    type TDBFieldInfo sch tab name :: RecFieldK NameNSK

-- | Extract 'FldDefK' from a plain field kind (for conditions, order, etc.).
type family PlainFldDef (r :: RecFieldK NameNSK) :: FldDefK where
  PlainFldDef ('RFPlain fd) = fd

-- | Field definition for (sch, tab, name) when the field is plain. Used by Select/Update conditions.
type family GetFldDef (sch :: k) (tab :: NameNSK) (name :: Symbol) :: FldDefK where
  GetFldDef sch tab name = PlainFldDef (TDBFieldInfo sch tab name)

-- CTabDef
-- | instances will be generated by code generation
class (ToStar name, ToStar (TTabDef sch name)) => CTabDef sch (name::NameNSK) where
  type TTabDef sch name :: TabDefK

-- | Relation definition for relation name ref.
class
  ( ToStar (TRelDef sch ref)
  , CTabDef sch (RdFrom (TRelDef sch ref))
  , CTabDef sch (RdTo (TRelDef sch ref)) )
  => CRelDef sch (ref :: NameNSK) where
    type TRelDef sch (ref :: NameNSK) :: RelDefK

getFldDef :: forall sch t n. ToStar (TDBFieldInfo sch t n) => FldDef
getFldDef :: forall {k} (sch :: k) (t :: NameNSK) (n :: Symbol).
ToStar (TDBFieldInfo sch t n) =>
FldDef
getFldDef = case forall {k} (a :: k). (SingKind k, SingI a) => Demote k
forall (a :: RecFieldK NameNSK).
(SingKind (RecFieldK NameNSK), SingI a) =>
Demote (RecFieldK NameNSK)
demote @(TDBFieldInfo sch t n) of
  RFPlain FldDef
fd -> FldDef
fd
  Demote (RecFieldK NameNSK)
_ -> String -> FldDef
forall a. HasCallStack => String -> a
error String
"impossible"

class CTabRels sch (tab :: NameNSK) where
  type TFrom sch tab :: [NameNSK]
  type TTo sch tab :: [NameNSK]

genDefunSymbols [''TTypDef, ''TDBFieldInfo, ''GetFldDef, ''TTabDef, ''TRelDef, ''TFrom, ''TTo]

type family Map2 (f :: a ~> b) (xs :: [a]) :: [(a,b)] where
  Map2 f '[] = '[]
  Map2 f (x ': xs) = '(x, Apply f x) ': Map2 f xs

type family Map3 (f :: a ~> b) (g :: c ~> [a]) (xs :: [c]) :: [[(a,b)]] where
  Map3 f g '[] = '[]
  Map3 f g (x ': xs) = Map2 f (Apply g x) ': Map3 f g xs

type TTabRelFrom sch tab = Map2 (TRelDefSym1 sch) (TFrom sch tab)
type TTabRelTo sch tab = Map2 (TRelDefSym1 sch) (TTo sch tab)

-- | The main class for schema. All DML operations are based on this class.
-- It contains all the information about the schema: tables, relations, fields, types.
--
-- This class guarantees that we can demote all the necessary information about the schema from type level to value level.
--
-- Instances will be generated by code generation
class
  ( ToStar (TTabs sch)
  , ToStar (TTabRelFroms sch)
  , ToStar (TTabRelTos sch)
  , ToStar (TTabFldDefs sch)
  , ToStar (TTabFlds sch)
  , ToStar (TTabDefs sch)
  , ToStar (TTypes sch)
  , ToStar (Map1 (TTypDefSym1 sch) (TTypes sch))
  )
  => CSchema sch where

  type TTabs sch    :: [NameNSK]
  type TTypes sch   :: [NameNSK]

type TTabDefs sch = Map1 (TTabDefSym1 sch) (TTabs sch)
type TTabFlds sch = Map1 TdFldsSym0 (TTabDefs sch)

type family TTabFldDefsList sch (tabs :: [NameNSK]) (tabFlds :: [[Symbol]]) :: [[FldDefK]] where
  TTabFldDefsList sch '[] '[] = '[]
  TTabFldDefsList sch (t ': ts) (f ': fs) = Map1 (GetFldDefSym2 sch t) f ': TTabFldDefsList sch ts fs

type TTabFldDefs sch = TTabFldDefsList sch (TTabs sch) (TTabFlds sch)
type TTabRelFroms sch = Map3 (TRelDefSym1 sch) (TFromSym1 sch) (TTabs sch)
type TTabRelTos sch = Map3 (TRelDefSym1 sch) (TToSym1 sch) (TTabs sch)

--
data TabInfo = TabInfo
  { TabInfo -> TabDef
tiDef  :: TabDef
  , TabInfo -> Map Text FldDef
tiFlds :: M.Map Text FldDef
  , TabInfo -> Map NameNS RelDef
tiFrom :: M.Map NameNS RelDef
  , TabInfo -> Map NameNS RelDef
tiTo   :: M.Map NameNS RelDef }
  deriving Int -> TabInfo -> ShowS
[TabInfo] -> ShowS
TabInfo -> String
(Int -> TabInfo -> ShowS)
-> (TabInfo -> String) -> ([TabInfo] -> ShowS) -> Show TabInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TabInfo -> ShowS
showsPrec :: Int -> TabInfo -> ShowS
$cshow :: TabInfo -> String
show :: TabInfo -> String
$cshowList :: [TabInfo] -> ShowS
showList :: [TabInfo] -> ShowS
Show

tabInfoMap :: forall sch. CSchema sch => M.Map NameNS TabInfo
tabInfoMap :: forall {k} (sch :: k). CSchema sch => Map NameNS TabInfo
tabInfoMap = [(NameNS, TabInfo)] -> Map NameNS TabInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (NameNS
tabName, TabInfo
tabInfo)
  | NameNS
tabName <- forall (a :: [NameNSK]).
(SingKind [NameNSK], SingI a) =>
Demote [NameNSK]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabs sch)
  | TabInfo
tabInfo <-
    [ TabInfo{Map Text FldDef
Map NameNS RelDef
TabDef
tiDef :: TabDef
tiFlds :: Map Text FldDef
tiFrom :: Map NameNS RelDef
tiTo :: Map NameNS RelDef
tiDef :: TabDef
tiFlds :: Map Text FldDef
tiFrom :: Map NameNS RelDef
tiTo :: Map NameNS RelDef
..}
    | TabDef
tiDef <- forall (a :: [TabDefK]).
(SingKind [TabDefK], SingI a) =>
Demote [TabDefK]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabDefs sch)
    | Map Text FldDef
tiFlds <-
      [ [(Text, FldDef)] -> Map Text FldDef
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, FldDef)] -> Map Text FldDef)
-> [(Text, FldDef)] -> Map Text FldDef
forall a b. (a -> b) -> a -> b
$ [Text] -> [FldDef] -> [(Text, FldDef)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Text]
fs [FldDef]
ds
      | [Text]
fs <- forall (a :: [[Symbol]]).
(SingKind [[Symbol]], SingI a) =>
Demote [[Symbol]]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabFlds sch)
      | [FldDef]
ds <- forall (a :: [[FldDefK]]).
(SingKind [[FldDefK]], SingI a) =>
Demote [[FldDefK]]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabFldDefs sch) ]
    | Map NameNS RelDef
tiFrom <- [(NameNS, RelDef)] -> Map NameNS RelDef
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NameNS, RelDef)] -> Map NameNS RelDef)
-> [[(NameNS, RelDef)]] -> [Map NameNS RelDef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [[(NameNSK, RelDefK)]]).
(SingKind [[(NameNSK, RelDefK)]], SingI a) =>
Demote [[(NameNSK, RelDefK)]]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabRelFroms sch)
    | Map NameNS RelDef
tiTo <- [(NameNS, RelDef)] -> Map NameNS RelDef
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NameNS, RelDef)] -> Map NameNS RelDef)
-> [[(NameNS, RelDef)]] -> [Map NameNS RelDef]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [[(NameNSK, RelDefK)]]).
(SingKind [[(NameNSK, RelDefK)]], SingI a) =>
Demote [[(NameNSK, RelDefK)]]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTabRelTos sch) ] ]

typDefMap :: forall sch. CSchema sch => M.Map NameNS TypDef
typDefMap :: forall {k} (sch :: k). CSchema sch => Map NameNS TypDef
typDefMap = [(NameNS, TypDef)] -> Map NameNS TypDef
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(NameNS, TypDef)] -> Map NameNS TypDef)
-> [(NameNS, TypDef)] -> Map NameNS TypDef
forall a b. (a -> b) -> a -> b
$ [NameNS] -> [TypDef] -> [(NameNS, TypDef)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip
  (forall (a :: [NameNSK]).
(SingKind [NameNSK], SingI a) =>
Demote [NameNSK]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(TTypes sch)) (forall (a :: [TypDefK]).
(SingKind [TypDefK], SingI a) =>
Demote [TypDefK]
forall {k} (a :: k). (SingKind k, SingI a) => Demote k
demote @(Map1 (TTypDefSym1 sch) (TTypes sch)))

type TRelTab sch t name = GetRelTab
  (Map2 (TRelDefSym1 sch) (TFrom sch t)) (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
  TabOnPath2 sch t (x ': xs) = TabOnPath2 sch (Fst (TRelTab sch t x)) xs

type TabOnPath sch (t :: NameNSK) (path :: [Symbol]) = Fst (TabOnPath2 sch t path)

--
type family TabPath sch (t :: NameNSK) (path :: [Symbol]) :: Constraint where
  TabPath sch t '[] = ()
  TabPath sch t (x ': xs) = TabPath sch (Fst (TRelTab sch t x)) xs

type RecField = RecField' Text
type Ref = Ref' Text

-- | Value-level: whether any ref in the list has a nullable column.
-- Companion to type-level 'HasNullableRefs'.
hasNullableRefs :: [Ref] -> Bool
hasNullableRefs :: [Ref] -> Bool
hasNullableRefs = (Ref -> Bool) -> [Ref] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any (FldDef -> Bool
forall s. FldDef' s -> Bool
fdNullable (FldDef -> Bool) -> (Ref -> FldDef) -> Ref -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref -> FldDef
forall s. Ref' s -> FldDef' s
fromDef)

qualName :: NameNS -> Text
qualName :: NameNS -> Text
qualName NameNS {Text
nnsNamespace :: forall s. NameNS' s -> s
nnsName :: forall s. NameNS' s -> s
nnsNamespace :: Text
nnsName :: Text
..}
  | Text
nnsNamespace Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
forall a. IsString a => String -> a
fromString String
"pg_catalog" = Text
nnsName
  | Bool
otherwise = Text
nnsNamespace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString String
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nnsName