squeal-postgresql 0.8.0.0 → 0.8.1.0

raw patch · 6 files changed

+339/−17 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• squeal-postgresql.cabal +1/−1
• src/Squeal/PostgreSQL/Expression/Aggregate.hs +42/−0
• src/Squeal/PostgreSQL/Expression/Parameter.hs +57/−8
• src/Squeal/PostgreSQL/Type/Alias.hs +84/−8
• src/Squeal/PostgreSQL/Type/List.hs +43/−0
• src/Squeal/PostgreSQL/Type/Schema.hs +112/−0

@@ -1,5 +1,5 @@ name: squeal-postgresql-version: 0.8.0.0+version: 0.8.1.0 synopsis: Squeal PostgreSQL Library description: Squeal is a type-safe embedding of PostgreSQL in Haskell homepage: https://github.com/morphismtech/squeal

@@ -566,6 +566,48 @@   varPop = unsafeAggregate "var_pop"   varSamp = unsafeAggregate "var_samp" +-- provides a nicer type error when we forget to group by+-- note that we need to make our 'a' polymorphic so that we can still match when it's ambiguous+instance ( TypeError ('Text "Cannot use aggregate functions to construct an Ungrouped Expression. Add a 'groupBy' to your TableExpression. If you want to aggregate across the entire result set, use 'groupBy Nil'.")+         , a ~ AggregateArg+         ) => Aggregate a (Expression 'Ungrouped) where+  countStar = impossibleAggregateError+  count = impossibleAggregateError+  sum_ = impossibleAggregateError+  arrayAgg = impossibleAggregateError+  jsonAgg = impossibleAggregateError+  jsonbAgg = impossibleAggregateError+  bitAnd = impossibleAggregateError+  bitOr = impossibleAggregateError+  boolAnd = impossibleAggregateError+  boolOr = impossibleAggregateError+  every = impossibleAggregateError+  max_ = impossibleAggregateError+  min_ = impossibleAggregateError+  avg = impossibleAggregateError+  corr = impossibleAggregateError+  covarPop = impossibleAggregateError+  covarSamp = impossibleAggregateError+  regrAvgX = impossibleAggregateError+  regrAvgY = impossibleAggregateError+  regrCount = impossibleAggregateError+  regrIntercept = impossibleAggregateError+  regrR2 = impossibleAggregateError+  regrSlope = impossibleAggregateError+  regrSxx = impossibleAggregateError+  regrSxy = impossibleAggregateError+  regrSyy = impossibleAggregateError+  stddev = impossibleAggregateError+  stddevPop = impossibleAggregateError+  stddevSamp = impossibleAggregateError+  variance = impossibleAggregateError+  varPop = impossibleAggregateError+  varSamp = impossibleAggregateError++-- | helper function for our errors above+impossibleAggregateError :: a+impossibleAggregateError = error "impossible; called aggregate function for Ungrouped even though the Aggregate instance has a type error constraint."+ -- | escape hatch to define aggregate functions unsafeAggregate   :: SOP.SListI xs

@@ -21,6 +21,7 @@   , RankNTypes   , ScopedTypeVariables   , TypeApplications+  , TypeFamilies   , TypeOperators   , UndecidableInstances #-}@@ -31,6 +32,8 @@   , param   ) where +import Data.Kind (Constraint)+import GHC.Exts (Any) import GHC.TypeLits  import Squeal.PostgreSQL.Expression@@ -49,11 +52,11 @@ separately from the SQL command string, in which case `param`s are used to refer to the out-of-line data values. -}-class KnownNat n => HasParameter-  (n :: Nat)+class KnownNat ix => HasParameter+  (ix :: Nat)   (params :: [NullType])   (ty :: NullType)-  | n params -> ty where+  | ix params -> ty where     -- | `parameter` takes a `Nat` using type application and a `TypeExpression`.     --     -- >>> printSQL (parameter @1 int4)@@ -62,12 +65,58 @@       :: TypeExpression db ty       -> Expression grp lat with db params from ty     parameter ty = UnsafeExpression $ parenthesized $-      "$" <> renderNat @n <+> "::"+      "$" <> renderNat @ix <+> "::"         <+> renderSQL ty-instance {-# OVERLAPPING #-} params ~ (x ': xs) => HasParameter 1 params x-instance {-# OVERLAPPABLE #-}-  (KnownNat n, HasParameter (n-1) xs x, params ~ (y ': xs))-  => HasParameter n params x++-- we could do the check for 0 in @HasParameter'@, but this way forces checking 'ix' before delegating,+-- which has the nice effect of ambiguous 'ix' errors mentioning 'HasParameter' instead of @HasParameter'@+instance {-# OVERLAPS #-} (TypeError ('Text "Tried to get the param at index 0, but params are 1-indexed"), x ~ Any) => HasParameter 0 params x+instance {-# OVERLAPS #-} (KnownNat ix, HasParameter' ix params ix params x) => HasParameter ix params x++-- | @HasParameter'@ is an implementation detail of 'HasParameter' allowing us to+-- include the full parameter list in our errors. Generally speaking it shouldn't leak to users+-- of the library+class KnownNat ix => HasParameter'+  (originalIx :: Nat)+  (allParams :: [NullType])+  (ix :: Nat)+  (params :: [NullType])+  (ty :: NullType)+  | ix params -> ty where+instance {-# OVERLAPS #-}+  ( params ~ (y ': xs)+  , y ~ x -- having a separate 'y' type variable is required for 'ParamTypeMismatchError'+  , ParamOutOfBoundsError originalIx allParams params+  , ParamTypeMismatchError originalIx allParams x y+  ) => HasParameter' originalIx allParams 1 params x+instance {-# OVERLAPS #-}+  ( KnownNat ix+  , HasParameter' originalIx allParams (ix-1) xs x+  , params ~ (y ': xs)+  , ParamOutOfBoundsError originalIx allParams params+  )+  => HasParameter' originalIx allParams ix params x++-- | @ParamOutOfBoundsError@ reports a nicer error with more context when we try to do an out-of-bounds lookup successfully do a lookup but+-- find a different field than we expected, or when we find ourself out of bounds+type family ParamOutOfBoundsError (originalIx :: Nat) (allParams :: [NullType]) (params :: [NullType]) :: Constraint where+  ParamOutOfBoundsError originalIx allParams '[] = TypeError+    ('Text "Index " ':<>: 'ShowType originalIx ':<>: 'Text " is out of bounds in 1-indexed parameter list:" ':$$: 'ShowType allParams)+  ParamOutOfBoundsError _ _ _ = ()++-- | @ParamTypeMismatchError@ reports a nicer error with more context when we successfully do a lookup but+-- find a different field than we expected, or when we find ourself out of bounds+type family ParamTypeMismatchError  (originalIx :: Nat) (allParams :: [NullType]) (found :: NullType) (expected :: NullType) :: Constraint where+  ParamTypeMismatchError _ _ found found = ()+  ParamTypeMismatchError originalIx allParams found expected = TypeError+    (     'Text "Type mismatch when looking up param at index " ':<>: 'ShowType originalIx+    ':$$: 'Text "in 1-indexed parameter list:"+    ':$$: 'Text "  " ':<>: 'ShowType allParams+    ':$$: 'Text ""+    ':$$: 'Text "Expected: " ':<>: 'ShowType expected+    ':$$: 'Text "But found: " ':<>: 'ShowType found+    ':$$: 'Text ""+    )  -- | `param` takes a `Nat` using type application and for basic types, -- infers a `TypeExpression`.

@@ -47,6 +47,11 @@   , HasErr   , HasAll   , HasIn+    -- * Error reporting+  , LookupFailedError+  , PrettyPrintHaystack+  , PrettyPrintInfo(..)+  , MismatchError     -- * Qualified Aliases   , QualifiedAlias (..)   , IsQualified (..)@@ -58,6 +63,7 @@ import Control.DeepSeq import Data.ByteString (ByteString) import Data.String (fromString)+import GHC.Exts (Any, Constraint) import GHC.OverloadedLabels import GHC.TypeLits @@ -184,20 +190,90 @@ -- | @Has alias fields field@ is a constraint that proves that -- @fields@ has a field of @alias ::: field@, inferring @field@ -- from @alias@ and @fields@.-type Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)-  = HasErr fields alias fields field+class (KnownSymbol alias) => Has (alias :: Symbol) (fields :: [(Symbol, kind)]) (field :: kind) | alias fields -> field+-- having these instances forces 'Has' to inspect 'alias' and 'fields' and thereby fail before delegating to+-- 'HasErr', which means 'Has' shows up in error messages instead of 'HasErr'+instance {-# OVERLAPPING #-} (KnownSymbol alias, HasErr (alias ::: field0 ': fields) alias (alias ::: field0 ': fields) field1)+  => Has alias (alias ::: field0 ': fields) field1+instance {-# OVERLAPPABLE #-} (KnownSymbol alias, HasErr (field' ': fields) alias (field' ': fields) field)+  => Has alias (field' ': fields) field+instance (KnownSymbol alias, HasErr '[] alias '[] field)+  => Has alias '[] field -{- | `HasErr` is like `Has` except it also retains the original+{- | 'HasErr' is like `Has` except it also retains the original list of fields being searched, so that error messages are more useful. -} class KnownSymbol alias =>-  HasErr err (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)+  HasErr (allFields :: [(Symbol, kind)]) (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)   | alias fields -> field where-instance {-# OVERLAPPING #-} (KnownSymbol alias, field0 ~ field1)-  => HasErr err alias (alias ::: field0 ': fields) field1-instance {-# OVERLAPPABLE #-} (KnownSymbol alias, HasErr err alias fields field)-  => HasErr err alias (field' ': fields) field+instance {-# OVERLAPPING #-} (KnownSymbol alias, field0 ~ field1, MismatchError alias allFields field0 field1)+  => HasErr allFields alias (alias ::: field0 ': fields) field1+instance {-# OVERLAPPABLE #-} (KnownSymbol alias, HasErr allFields alias fields field)+  => HasErr allFields alias (field' ': fields) field+instance ( KnownSymbol alias+         , LookupFailedError alias allFields -- report a nicer error+         , field ~ Any -- required to satisfy the fundep+         ) => HasErr allFields alias '[] field++-- | @MismatchError@ reports a nicer error with more context when we successfully do a lookup but+-- find a different field than we expected+type MismatchError (alias :: Symbol) (fields :: [(Symbol, kind)]) (found :: kind) (expected :: kind)+  = MismatchError' (MismatchError' () (DefaultPrettyPrinter fields) alias fields found expected) (PrettyPrintHaystack fields) alias fields found expected++-- | @MismatchError'@ is the workhorse behind @MismatchError@, but taking an additional type as the first argument. We can put another type error+-- in there which will only show if @MismatchError'@ is stuck; this allows us to fall back to @DefaultPrettyPrinter@ when a @PrettyPrintHaystack@ instance+-- is missing+type family MismatchError' (err :: Constraint) (ppInfo :: PrettyPrintInfo) (alias :: Symbol) (fields :: [(Symbol, kind)]) (found :: kind) (expected :: kind) :: Constraint where+  MismatchError' _ _ _ _ found found = ()+  MismatchError' _ ('PrettyPrintInfo needleName haystackName _) alias fields found expected = TypeError+    (     'Text "Type mismatch when looking up " ':<>: needleName ':<>: 'Text " named " ':<>: 'ShowType alias+    ':$$: 'Text "in " ':<>: haystackName ':<>: 'Text ":"+    -- we don't use a pretty haystack because we want to show the values+    ':$$: 'ShowType fields+    ':$$: 'Text ""+    ':$$: 'Text "Expected: " ':<>: 'ShowType expected+    ':$$: 'Text "But found: " ':<>: 'ShowType found+    ':$$: 'Text ""+    )++-- | @LookupFailedError@ reports a nicer error when we fail to look up some @needle@ in some @haystack@+type LookupFailedError needle haystack = LookupFailedError' (LookupFailedError' () (DefaultPrettyPrinter haystack) needle haystack) (PrettyPrintHaystack haystack) needle haystack++-- | @LookupFailedError'@ is the workhorse behind @LookupFailedError@, but taking an additional type as the first argument. We can put another type error+-- in there which will only show if @LookupFailedError'@ is stuck; this allows us to fall back to @DefaultPrettyPrinter@ when a @PrettyPrintHaystack@ instance+-- is missing+type family LookupFailedError' (fallbackForUnknownKind :: Constraint) (prettyPrintInfo :: PrettyPrintInfo) (needle :: Symbol) (haystack :: [(Symbol, k)]) :: Constraint where+  LookupFailedError' _ ('PrettyPrintInfo needleName haystackName prettyHaystack) needle rawHaystack = TypeError+    (     'Text "Could not find " ':<>: needleName ':<>: 'Text " named " ':<>: 'ShowType needle+    ':$$: 'Text "in " ':<>: haystackName ':<>: 'Text ":"+    ':$$: prettyHaystack+    ':$$: 'Text ""+    ':$$: 'Text "*Raw " ':<>: haystackName ':<>: 'Text "*:"+    ':$$: 'ShowType rawHaystack+    ':$$: 'Text ""+    )++-- | @PrettyPrintInfo@ is a data type intended to be used at the type level+-- which describes how to pretty print a haystack in our custom errors. The general intention is we use @PrettyPrintHaystack@+-- to define a more specific way of pretty printing our error information for each kind that we care about+data PrettyPrintInfo = PrettyPrintInfo+  { _needleName :: ErrorMessage+  , _haystackName :: ErrorMessage+  , _haystackPrettyPrint :: ErrorMessage+  }++-- | 'PrettyPrintHaystack' allows us to use the kind of our haystack to come up+-- with nicer errors. It is implemented as an open type family for dependency reasons+type family PrettyPrintHaystack (haystack :: [(Symbol, k)]) :: PrettyPrintInfo++-- | @DefaultPrettyPrinter@ provides a default we can use for kinds that don't provide an instance of @PrettyPrintInfo@,+-- although that should generally only be accidental+type family DefaultPrettyPrinter (haystack :: [(Symbol, k)]) :: PrettyPrintInfo where+  DefaultPrettyPrinter (haystack :: [(Symbol, k)]) = 'PrettyPrintInfo+    ('Text "some kind without a PrettyPrintHaystack instance ("  ':<>: 'ShowType k ':<>: 'Text ")")+    ('Text "associative list of that kind ([(Symbol, "  ':<>: 'ShowType k ':<>: 'Text ")])")+    ('ShowType (Sort (MapFst haystack)))  {-| @HasIn fields (alias ::: field)@ is a constraint that proves that @fields@ has a field of @alias ::: field@. It is used in @UPDATE@s to

@@ -41,6 +41,8 @@   , Elem   , In   , Length+  , MapFst+  , Sort   , SubList   , SubsetList   ) where@@ -154,3 +156,44 @@ type family SubsetList (xs :: [k]) (ys :: [k]) :: Bool where   SubsetList '[] ys = 'True   SubsetList (x ': xs) ys = Elem x ys && SubsetList xs ys++-- | 'Sort' sorts a type level list of 'Symbol's in ascending lexicographic order+type Sort ls = MergeSort (Twos ls)++-- | 'MergeSort' is the workhorse behind 'Sort'+type family MergeSort (ls :: [[Symbol]]) :: [Symbol] where+  MergeSort '[]  = '[]+  MergeSort '[x] = x+  MergeSort ls   = MergeSort (FoldMerge ls)++-- | @Two@s splits a type-level list into a list of sorted lists of length 2 (with a singelton list potentially at the end)+-- It is required for implementing 'MergeSort'+type family Twos (ls :: [k]) :: [[k]] where+  Twos (x ': y ': rs) = Merge '[x] '[y] ': Twos rs+  Twos '[x]           = '[ '[x]]+  Twos '[]            = '[]++-- | 'Merge' two sorted lists into one list+type family Merge (ls :: [Symbol]) (rs :: [Symbol]) :: [Symbol] where+  Merge '[] r = r+  Merge l '[] = l+  Merge (l ': ls) (r ': rs) = If (Leq l r) (l ': Merge ls (r ': rs)) (r ': Merge (l ': ls) rs)++-- | 'FoldMerge' folds over a list of sorted lists, merging them into a single sorted list+type family FoldMerge (ls :: [[Symbol]]) :: [[Symbol]] where+  FoldMerge (x ': y ': rs) = (Merge x y ': FoldMerge rs)+  FoldMerge '[x]           = '[x]+  FoldMerge '[]            = '[]++type Leq l r = OrderingIsLeq (CmpSymbol l r)++type family OrderingIsLeq (o :: Ordering) :: Bool where+  OrderingIsLeq 'LT = 'True+  OrderingIsLeq 'EQ = 'True+  OrderingIsLeq 'GT = 'False++-- | 'MapFst' takes the first value of each tuple of a type level list of tuples. Useful for getting+-- only the names in associatve lists+type family MapFst (ls :: [(j, k)]) :: [j] where+  MapFst ('(j, _) ': rest) = j ': MapFst rest+  MapFst '[] = '[]

@@ -49,7 +49,17 @@   , ReturnsType (..)   , SchemaType   , SchemasType+  , PrettyPrintPartitionedSchema   , Public+  , PartitionedSchema(..)+  , PartitionSchema+  , SchemaFunctions+  , SchemaIndexes+  , SchemaProcedures+  , SchemaTables+  , SchemaTypes+  , SchemaUnsafes+  , SchemaViews     -- * Database Subsets   , SubDB   , SubsetDB@@ -204,6 +214,9 @@ -- :} type ColumnsType = [(Symbol,ColumnType)] +type instance PrettyPrintHaystack (haystack :: ColumnsType) =+  'PrettyPrintInfo ('Text "column definition (ColumnType)") ('Text "table (ColumnsType)") ('ShowType (Sort (MapFst haystack)))+ -- | `TableConstraint` encodes various forms of data constraints -- of columns in a table. -- `TableConstraint`s give you as much control over the data in your tables@@ -225,6 +238,9 @@ -} type TableConstraints = [(Symbol,TableConstraint)] +type instance PrettyPrintHaystack (haystack :: TableConstraints) =+  'PrettyPrintInfo ('Text "constraint (TableConstraint)") ('Text "table (TableConstraints)") ('ShowType (Sort (MapFst haystack)))+ -- | A `ForeignKey` must reference columns that either are -- a `PrimaryKey` or form a `Unique` constraint. type family Uniquely@@ -261,12 +277,18 @@ -} type RowType = [(Symbol,NullType)] +type instance PrettyPrintHaystack (haystack :: RowType) =+  'PrettyPrintInfo ('Text "column (NullType)") ('Text "row (RowType)") ('ShowType (Sort (MapFst haystack)))+ {- | `FromType` is a row of `RowType`s. It can be thought of as a product, or horizontal gluing and is used in `Squeal.PostgreSQL.Query.From.FromClause`s and `Squeal.PostgreSQL.Query.Table.TableExpression`s. -} type FromType = [(Symbol,RowType)] +type instance PrettyPrintHaystack (haystack :: FromType) =+  'PrettyPrintInfo ('Text "row (RowType)") ('Text "from clause (FromType)") ('ShowType (Sort (MapFst haystack)))+ -- | `ColumnsToRow` removes column constraints. type family ColumnsToRow (columns :: ColumnsType) :: RowType where   ColumnsToRow (column ::: _ :=> ty ': columns) =@@ -571,6 +593,93 @@ -} type SchemaType = [(Symbol,SchemumType)] +-- | A @PartitionedSchema@ is a @SchemaType@ where each constructor of @SchemumType@ has+-- been separated into its own list+data PartitionedSchema = PartitionedSchema+  { _tables     :: [(Symbol, TableType)]+  , _views      :: [(Symbol, RowType)]+  , _types      :: [(Symbol, PGType)]+  , _indexes    :: [(Symbol, IndexType)]+  , _functions  :: [(Symbol, FunctionType)]+  , _procedures :: [(Symbol, [NullType])]+  , _unsafes    :: [(Symbol, Symbol)]+  }++-- | @PartitionSchema@ partitions a @SchemaType@ into a @PartitionedSchema@+type PartitionSchema schema = PartitionSchema' schema ('PartitionedSchema '[] '[] '[] '[] '[] '[] '[])++type family PartitionSchema' (remaining :: SchemaType) (acc :: PartitionedSchema) :: PartitionedSchema where+  PartitionSchema' '[] ps = ps+  PartitionSchema' ('(s, 'Table table) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema ('(s, table) ': tables) views types indexes functions procedures unsafe)+  PartitionSchema' ('(s, 'View view) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables ('(s, view) ': views) types indexes functions procedures unsafe)+  PartitionSchema' ('(s, 'Typedef typ) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables views ('(s, typ) ': types) indexes functions procedures unsafe)+  PartitionSchema' ('(s, 'Index ix) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables views types ('(s, ix) ': indexes) functions procedures unsafe)+  PartitionSchema' ('(s, 'Function f) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables views types indexes ('(s, f) ': functions) procedures unsafe)+  PartitionSchema' ('(s, 'Procedure p) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables views types indexes functions ('(s, p) ': procedures) unsafe)+  PartitionSchema' ('(s, 'UnsafeSchemum u) ': rest) ('PartitionedSchema tables views types indexes functions procedures unsafe)+    = PartitionSchema' rest ('PartitionedSchema tables views types indexes functions procedures ('(s, u) ': unsafe))++-- | Get the tables from a @PartitionedSchema@+type family SchemaTables (schema :: PartitionedSchema) :: [(Symbol, TableType)] where+  SchemaTables ('PartitionedSchema tables _ _ _ _ _ _) = tables+-- | Get the views from a @PartitionedSchema@+type family SchemaViews (schema :: PartitionedSchema) :: [(Symbol, RowType)] where+  SchemaViews ('PartitionedSchema _ views _ _ _ _ _) = views+-- | Get the typedefs from a @PartitionedSchema@+type family SchemaTypes (schema :: PartitionedSchema) :: [(Symbol, PGType)] where+  SchemaTypes ('PartitionedSchema _ _ types _ _ _ _) = types+-- | Get the indexes from a @PartitionedSchema@+type family SchemaIndexes (schema :: PartitionedSchema) :: [(Symbol, IndexType)] where+  SchemaIndexes ('PartitionedSchema _ _ _ indexes _ _ _) = indexes+-- | Get the functions from a @PartitionedSchema@+type family SchemaFunctions (schema :: PartitionedSchema) :: [(Symbol, FunctionType)] where+  SchemaFunctions ('PartitionedSchema _ _ _ _ functions _ _) = functions+-- | Get the procedured from a @PartitionedSchema@+type family SchemaProcedures (schema :: PartitionedSchema) :: [(Symbol, [NullType])] where+  SchemaProcedures ('PartitionedSchema _ _ _ _ _ procedures _) = procedures+-- | Get the unsafe schema types from a @PartitionedSchema@+type family SchemaUnsafes (schema :: PartitionedSchema) :: [(Symbol, Symbol)] where+  SchemaUnsafes ('PartitionedSchema _ _ _ _ _ _ unsafes) = unsafes++-- | @PrettyPrintPartitionedSchema@ makes a nice @ErrorMessage@ showing a @PartitionedSchema@,+-- only including the names of the things in it and not the values. Additionally, empty+-- fields are omitted+type family PrettyPrintPartitionedSchema (schema :: PartitionedSchema) :: ErrorMessage where+  PrettyPrintPartitionedSchema schema = IntersperseNewlines (FilterNonEmpty+    [ FieldIfNonEmpty "Tables"              (SchemaTables schema)+    , FieldIfNonEmpty "Views"               (SchemaViews schema)+    , FieldIfNonEmpty "Types"               (SchemaTypes schema)+    , FieldIfNonEmpty "Indexes"             (SchemaIndexes schema)+    , FieldIfNonEmpty "Functions"           (SchemaFunctions schema)+    , FieldIfNonEmpty "Procedures"          (SchemaProcedures schema)+    , FieldIfNonEmpty "Unsafe schema items" (SchemaUnsafes schema)+    ])++type family FieldIfNonEmpty (fieldName :: Symbol) (value :: [(Symbol, k)]) :: ErrorMessage where+  FieldIfNonEmpty _ '[] = 'Text ""+  FieldIfNonEmpty n xs = 'Text "  " ':<>: 'Text n ':<>: 'Text ":" ':$$: 'Text "    " ':<>: 'ShowType (Sort (MapFst xs))++type family FilterNonEmpty (ls :: [ErrorMessage]) :: [ErrorMessage] where+  FilterNonEmpty ('Text "" ': rest) = FilterNonEmpty rest+  FilterNonEmpty (x ': rest) = x ': FilterNonEmpty rest+  FilterNonEmpty '[] = '[]++type family IntersperseNewlines (ls :: [ErrorMessage]) :: ErrorMessage where+  IntersperseNewlines (x ': y ': '[]) = x ':$$: y+  IntersperseNewlines (x ': xs) = x ':$$: IntersperseNewlines xs+  IntersperseNewlines '[] = 'Text ""++type instance PrettyPrintHaystack (haystack :: SchemaType) =+  'PrettyPrintInfo ('Text "table, view, typedef, index, function, or procedure (SchemumType)") ('Text "schema (SchemaType)")+  ( PrettyPrintPartitionedSchema (PartitionSchema haystack)+  )+ {- | A database contains one or more named schemas, which in turn contain tables. The same object name can be used in different schemas without conflict;@@ -587,6 +696,9 @@   so they do not collide with the names of other objects. -} type SchemasType = [(Symbol,SchemaType)]++type instance PrettyPrintHaystack (haystack :: SchemasType) =+  'PrettyPrintInfo ('Text "schema (SchemaType)") ('Text "database (SchemasType)") ('Text "  " ':<>: 'ShowType (Sort (MapFst haystack)))  -- | A type family to use for a single schema database. type family Public (schema :: SchemaType) :: SchemasType