@@ -34,17 +34,24 @@ it defines an embedding of Haskell types into Postgres types.
3434#-}
3535
3636module Squeal.PostgreSQL.Schema
37− ( -- * Types
37+ ( -- * Postgres Types
3838 PGType (..)
39− , HasOid (..)
4039 , NullityType (..)
41− , ColumnType
42− -- * Tables
43− , ColumnsType
4440 , RowType
4541 , FromType
42+ -- * Haskell to Postgres Types
43+ , PG
44+ , NullPG
45+ , TuplePG
46+ , RowPG
47+ , Json (..)
48+ , Jsonb (..)
49+ , Composite (..)
50+ , Enumerated (..)
51+ -- * Schema Types
52+ , ColumnType
53+ , ColumnsType
4654 , TableType
47− -- * Schema
4855 , SchemumType (..)
4956 , SchemaType
5057 -- * Constraints
@@ -61,7 +68,6 @@ module Squeal.PostgreSQL.Schema
6168 , Aliased (As)
6269 , Aliasable (as)
6370 , renderAliasedAs
64− , AliasesOf
6571 , Has
6672 , HasUnique
6773 , HasAll
@@ -73,57 +79,45 @@ module Squeal.PostgreSQL.Schema
7379 , PGlabel (..)
7480 , renderLabel
7581 , renderLabels
82+ , LabelsPG
7683 -- * Grouping
7784 , Grouping (..)
7885 , GroupedBy
79− -- * Type Families
80− , Join
86+ -- * Aligned lists
87+ , AlignedList (..)
88+ , single
89+ -- * Data Definitions
8190 , Create
8291 , Drop
8392 , Alter
8493 , Rename
94+ , DropIfConstraintsInvolve
95+ -- * Lists
96+ , Join
8597 , Elem
8698 , In
8799 , Length
100+ -- * Type Classifications
101+ , HasOid (..)
88102 , PGNum
89103 , PGIntegral
90104 , PGFloating
91105 , PGTypeOf
92− , PGarrayOf
93− , PGarray
94− , PGtextArray
106+ , PGArrayOf
107+ , PGArray
108+ , PGTextArray
109+ , PGJsonType
110+ , PGJsonKey
95111 , SamePGType
96112 , AllNotNull
97113 , NotAllNull
114+ -- * Nullifications
98115 , NullifyType
99116 , NullifyRow
100117 , NullifyFrom
101− , ColumnsToRow
118+ -- * Table Conversions
102119 , TableToColumns
103120 , TableToRow
104− , ConstraintInvolves
105− , DropIfConstraintsInvolve
106− -- ** JSON support
107− , PGjson_
108− , PGjsonKey
109− -- * Immersion
110− , PG
111− , Json (..)
112− , Jsonb (..)
113− , Composite (..)
114− , Enumerated (..)
115− , NullPG
116− , TuplePG
117− , LabelsPG
118− , RowPG
119− , RowOf
120− , FieldPG
121− , ConstructorsOf
122− , ConstructorNameOf
123− , ConstructorNamesOf
124− -- * Aligned lists
125− , AlignedList (..)
126− , single
127121 ) where
128122
129123import Control.Category
@@ -305,19 +299,24 @@ type family Uniquely
305299-- :}
306300type TableType = (TableConstraints,ColumnsType)
307301
308−-- | `RowType` is a row of `NullityType`
309−--
310−-- >>> :{
311−-- type family PersonRelation :: RowType where
312−-- PersonRelation =
313−-- '[ "name" ::: 'NotNull 'PGtext
314−-- , "age" ::: 'NotNull 'PGint4
315−-- , "dateOfBirth" ::: 'Null 'PGdate
316−-- ]
317−-- :}
302+{- | A `RowType` is a row of `NullityType`. They correspond to Haskell
303+record types by means of `RowPG` and are used in many places.
304+
305+>>> :{
306+type family PersonRow :: RowType where
307+ PersonRow =
308+ '[ "name" ::: 'NotNull 'PGtext
309+ , "age" ::: 'NotNull 'PGint4
310+ , "dateOfBirth" ::: 'Null 'PGdate
311+ ]
312+:}
313+-}
318314type RowType = [(Symbol,NullityType)]
319315
320−-- | `FromType` is a row of `RowType`s, thought of as a product.
316+{- | `FromType` is a row of `RowType`s. It can be thought of as
317+a product, or horizontal gluing and is used in `Squeal.PostgreSQL.Query.FromClause`s
318+and `Squeal.PostgreSQL.Query.TableExpression`s.
319+-}
321320type FromType = [(Symbol,RowType)]
322321
323322-- | `ColumnsToRow` removes column constraints.
@@ -435,11 +434,6 @@ renderAliasedAs
435434renderAliasedAs render (expression `As` alias) =
436435 render expression <> " AS " <> renderAlias alias
437436
438−-- | `AliasesOf` retains the AliasesOf in a row.
439−type family AliasesOf aliaseds where
440− AliasesOf '[] = '[]
441− AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys
442−
443437-- | @HasUnique alias fields field@ is a constraint that proves that
444438-- @fields@ is a singleton of @alias ::: field@.
445439type HasUnique alias fields field = fields ~ '[alias ::: field]
@@ -486,21 +480,15 @@ type family Elem x xs where
486480-- | @In x xs@ is a constraint that proves that @x@ is in @xs@.
487481type family In x xs :: Constraint where In x xs = Elem x xs ~ 'True
488482
489−-- | `PGNum` is a constraint on `PGType` whose
490−-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.
491−type PGNum ty =
492− In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]
483+-- | Numeric Postgres types.
484+type PGNum =
485+ '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]
493486
494−-- | `PGFloating` is a constraint on `PGType` whose
495−-- `Squeal.PostgreSQL.Expression.Expression`s
496−-- have `Fractional` and `Floating` constraints.
497−type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]
487+-- | Floating Postgres types.
488+type PGFloating = '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]
498489
499−-- | `PGIntegral` is a constraint on `PGType` whose
500−-- `Squeal.PostgreSQL.Expression.Expression`s
501−-- have `Squeal.PostgreSQL.Expression.div_` and
502−-- `Squeal.PostgreSQL.Expression.mod_` functions.
503−type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]
490+-- | Integral Postgres types.
491+type PGIntegral = '[ 'PGint2, 'PGint4, 'PGint8]
504492
505493-- | Error message helper for displaying unavailable\/unknown\/placeholder type
506494-- variables whose kind is known.
@@ -511,27 +499,27 @@ type ErrPGfixarrayOf t = ErrArrayOf ('ShowType 'PGfixarray :<>: 'Text " " :<>: P
511499type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t
512500
513501-- | Ensure a type is a valid array type.
514−type family PGarray name arr :: Constraint where
515− PGarray name ('PGvararray x) = ()
516− PGarray name ('PGfixarray n x) = ()
517− PGarray name val = TypeError
518− ('Text name :<>: 'Text ": Unsatisfied PGarray constraint. Expected either: "
502+type family PGArray name arr :: Constraint where
503+ PGArray name ('PGvararray x) = ()
504+ PGArray name ('PGfixarray n x) = ()
505+ PGArray name val = TypeError
506+ ('Text name :<>: 'Text ": Unsatisfied PGArray constraint. Expected either: "
519507 :$$: 'Text " • " :<>: ErrPGvararrayOf (Placeholder PGType)
520508 :$$: 'Text " • " :<>: ErrPGfixarrayOf (Placeholder PGType)
521509 :$$: 'Text "But got: " :<>: 'ShowType val)
522510
523511-- | Ensure a type is a valid array type with a specific element type.
524−type family PGarrayOf name arr ty :: Constraint where
525− PGarrayOf name ('PGvararray x) ty = x ~ ty
526− PGarrayOf name ('PGfixarray n x) ty = x ~ ty
527− PGarrayOf name val ty = TypeError
528− ( 'Text name :<>: 'Text "Unsatisfied PGarrayOf constraint. Expected either: "
512+type family PGArrayOf name arr ty :: Constraint where
513+ PGArrayOf name ('PGvararray x) ty = x ~ ty
514+ PGArrayOf name ('PGfixarray n x) ty = x ~ ty
515+ PGArrayOf name val ty = TypeError
516+ ( 'Text name :<>: 'Text "Unsatisfied PGArrayOf constraint. Expected either: "
529517 :$$: 'Text " • " :<>: ErrPGvararrayOf ( 'ShowType ty )
530518 :$$: 'Text " • " :<>: ErrPGfixarrayOf ( 'ShowType ty )
531519 :$$: 'Text "But got: " :<>: 'ShowType val)
532520
533521-- | Ensure a type is a valid array type whose elements are text.
534−type PGtextArray name arr = PGarrayOf name arr ('NotNull 'PGtext)
522+type PGTextArray name arr = PGArrayOf name arr ('NotNull 'PGtext)
535523
536524-- | `PGTypeOf` forgets about @NULL@ and any column constraints.
537525type family PGTypeOf (ty :: NullityType) :: PGType where
@@ -628,6 +616,12 @@ type family DropIfConstraintsInvolve column constraints where
628616 (DropIfConstraintsInvolve column constraints)
629617 (alias ::: constraint ': DropIfConstraintsInvolve column constraints)
630618
619+{- | Calculate the `Length` of a type level list
620+
621+>>> :kind! Length '[Char,String,Bool,Double]
622+Length '[Char,String,Bool,Double] :: Nat
623+= 4
624+-}
631625type family Length (xs :: [k]) :: Nat where
632626 Length (x : xs) = 1 + Length xs
633627 Length '[] = 0
@@ -639,8 +633,28 @@ data SchemumType
639633 | View RowType
640634 | Typedef PGType
641635
642−-- | The schema of a database consists of a list of aliased,
643−-- user-defined `SchemumType`s.
636+{- | The schema of a database consists of a list of aliased,
637+user-defined `SchemumType`s.
638+
639+>>> :{
640+type family Schema :: SchemaType where
641+ Schema =
642+ '[ "users" ::: 'Table (
643+ '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>
644+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
645+ , "name" ::: 'NoDef :=> 'NotNull 'PGtext
646+ ])
647+ , "emails" ::: 'Table (
648+ '[ "pk_emails" ::: 'PrimaryKey '["id"]
649+ , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]
650+ ] :=>
651+ '[ "id" ::: 'Def :=> 'NotNull 'PGint4
652+ , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4
653+ , "email" ::: 'NoDef :=> 'Null 'PGtext
654+ ])
655+ ]
656+:}
657+-}
644658type SchemaType = [(Symbol,SchemumType)]
645659
646660-- | `IsPGlabel` looks very much like the `IsLabel` class. Whereas
@@ -664,12 +678,16 @@ renderLabels
664678renderLabels = hcollapse
665679 . hcmap (Proxy @KnownSymbol) (K . renderLabel)
666680
667−-- | The `PG` type family embeds a subset of Haskell types
668−-- as Postgres basic types.
669−--
670−-- >>> :kind! PG LocalTime
671−-- PG LocalTime :: PGType
672−-- = 'PGtimestamp
681+{- | The `PG` type family embeds a subset of Haskell types
682+as Postgres types. As an open type family, `PG` is extensible.
683+
684+>>> :kind! PG LocalTime
685+PG LocalTime :: PGType
686+= 'PGtimestamp
687+
688+>>> newtype MyDouble = My Double
689+>>> type instance PG MyDouble = 'PGfloat8
690+-}
673691type family PG (hask :: Type) :: PGType
674692type instance PG Bool = 'PGbool
675693type instance PG Int16 = 'PGint2
@@ -716,28 +734,53 @@ type instance PG (hask, hask, hask, hask, hask, hask, hask, hask, hask, hask)
716734type instance PG (Composite hask) = 'PGcomposite (RowPG hask)
717735type instance PG (Enumerated hask) = 'PGenum (LabelsPG hask)
718736
737+{- | The `Json` newtype is an indication that the Haskell
738+type it's applied to should be stored as `PGjson`.
739+-}
719740newtype Json hask = Json {getJson :: hask}
720741 deriving (Eq, Ord, Show, Read, GHC.Generic)
742+
743+{- | The `Jsonb` newtype is an indication that the Haskell
744+type it's applied to should be stored as `PGjsonb`.
745+-}
721746newtype Jsonb hask = Jsonb {getJsonb :: hask}
722747 deriving (Eq, Ord, Show, Read, GHC.Generic)
748+
749+{- | The `Composite` newtype is an indication that the Haskell
750+type it's applied to should be stored as a `PGcomposite`.
751+-}
723752newtype Composite record = Composite {getComposite :: record}
724753 deriving (Eq, Ord, Show, Read, GHC.Generic)
754+
755+{- | The `Enumerated` newtype is an indication that the Haskell
756+type it's applied to should be stored as `PGenum`.
757+-}
725758newtype Enumerated enum = Enumerated {getEnumerated :: enum}
726759 deriving (Eq, Ord, Show, Read, GHC.Generic)
727760
728−-- | The `LabelsPG` type family calculates the constructors of a
729−-- Haskell enum type.
730−--
731−-- >>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
732−-- >>> instance Generic Schwarma
733−-- >>> instance HasDatatypeInfo Schwarma
734−-- >>> :kind! LabelsPG Schwarma
735−-- LabelsPG Schwarma :: [Type.ConstructorName]
736−-- = '["Beef", "Lamb", "Chicken"]
761+{-| The `LabelsPG` type family calculates the constructors of a
762+Haskell enum type.
763+
764+>>> data Schwarma = Beef | Lamb | Chicken deriving GHC.Generic
765+>>> instance Generic Schwarma
766+>>> instance HasDatatypeInfo Schwarma
767+>>> :kind! LabelsPG Schwarma
768+LabelsPG Schwarma :: [Type.ConstructorName]
769+= '["Beef", "Lamb", "Chicken"]
770+-}
737771type family LabelsPG (hask :: Type) :: [Type.ConstructorName] where
738772 LabelsPG hask =
739773 ConstructorNamesOf (ConstructorsOf (DatatypeInfoOf hask))
740774
775+{- | `RowPG` turns a Haskell record type into a `RowType`.
776+
777+>>> data Person = Person { name :: Text, age :: Int32 } deriving GHC.Generic
778+>>> instance Generic Person
779+>>> instance HasDatatypeInfo Person
780+>>> :kind! RowPG Person
781+RowPG Person :: [(Symbol, NullityType)]
782+= '["name" ::: 'NotNull 'PGtext, "age" ::: 'NotNull 'PGint4]
783+-}
741784type family RowPG (hask :: Type) :: RowType where
742785 RowPG hask = RowOf (RecordCodeOf hask)
743786
@@ -748,10 +791,26 @@ type family RowOf (fields :: [(Symbol, Type)]) :: RowType where
748791type family FieldPG (field :: (Symbol, Type)) :: (Symbol, NullityType) where
749792 FieldPG (field ::: hask) = field ::: NullPG hask
750793
794+{- | `NullPG` turns a Haskell type into a `NullityType`.
795+
796+>>> :kind! NullPG Double
797+NullPG Double :: NullityType
798+= 'NotNull 'PGfloat8
799+>>> :kind! NullPG (Maybe Double)
800+NullPG (Maybe Double) :: NullityType
801+= 'Null 'PGfloat8
802+-}
751803type family NullPG (hask :: Type) :: NullityType where
752804 NullPG (Maybe hask) = 'Null (PG hask)
753805 NullPG hask = 'NotNull (PG hask)
754806
807+{- | `TuplePG` turns a Haskell tuple type (including record types) into
808+the corresponding list of `NullityType`s.
809+
810+>>> :kind! TuplePG (Double, Maybe Char)
811+TuplePG (Double, Maybe Char) :: [NullityType]
812+= '['NotNull 'PGfloat8, 'Null ('PGchar 1)]
813+-}
755814type family TuplePG (hask :: Type) :: [NullityType] where
756815 TuplePG hask = TupleOf (TupleCodeOf hask (Code hask))
757816
@@ -800,10 +859,10 @@ type family ConstructorNamesOf (constructors :: [Type.ConstructorInfo])
800859 ConstructorNameOf constructor ': ConstructorNamesOf constructors
801860
802861-- | Is a type a valid JSON key?
803−type PGjsonKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]
862+type PGJsonKey = '[ 'PGint2, 'PGint4, 'PGtext ]
804863
805864-- | Is a type a valid JSON type?
806−type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]
865+type PGJsonType = '[ 'PGjson, 'PGjsonb ]
807866
808867-- | An `AlignedList` is a type-aligned list or free category.
809868data AlignedList p x0 x1 where